Import Tix 8.4.3.5 (as of svn r86089)

tests/general/NoteBook.tcl

@@ -0,0 +1,64 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: NoteBook.tcl,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
+#
+proc About {} {
+    return "Testing the notebook widgets"
+}
+
+proc NoteBookPageConfig {w pages} {
+    foreach page $pages {
+	Assert {"x[$w pagecget $page -label]" == "x$page"}
+	Assert {"x[$w pageconfigure $page -label]" == "x-label {} {} {} $page"}
+	$w pageconfigure $page -label foo
+	Assert {"x[$w pagecget $page -label]" == "xfoo"}
+	update
+    }
+}
+
+proc Test {} {
+    foreach class {tixListNoteBook tixNoteBook tixStackWindow} {
+	set w [$class .d]
+	pack $w
+	update
+
+	set pages {1 2 3 4 5 6 1111111112221}
+
+	foreach page $pages {
+	    if {$class == "tixListNoteBook"} {
+		$w subwidget hlist add $page -itemtype imagetext \
+		    -image [tix getimage folder] -text $page
+	    }
+	    set p [$w add $page -label $page]
+	    for {set x 1} {$x < 10} {incr x} {
+		button $p.$x -text $x
+		pack $p.$x -fill x
+	    }
+	}
+
+	foreach page $pages {
+	    $w raise $page
+	    Assert {"x[$w raised]" == "x$page"}
+	    update
+	}
+
+	Assert {[string compare $pages [$w pages]] == 0}
+
+	# test the "hooking" of the notebook frame subwidget
+	#
+	#
+	if {$class == "tixNoteBook"} {
+	    NoteBookPageConfig $w $pages
+	}
+
+	foreach page $pages {
+	    Assert {"x[$w pagecget $page -raisecmd]" == "x"}
+#	    Assert {"x[$w pageconfigure $page -raisecmd]" == "x-raisecmd {} {} {} {}"}
+	    $w pageconfigure $page -raisecmd "RaiseCmd $page"
+	    Assert {"x[$w pagecget $page -raisecmd]" == "xRaiseCmd $page"}
+	    update
+	}
+
+	destroy $w
+    }
+}

tests/general/api.tcl

@@ -0,0 +1,258 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: api.tcl,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
+#
+# api.tcl --
+#
+#	Performs a comprehensive test on all the Tix widgets and
+#	commands. This test knows the types and arguments of many
+#	common Tix widget methods. It calls each widget method and
+#	ensure that it work as expected.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+set depd(init)	       ""
+set info(init)         "Initialization, find out all the widget classes"
+set depd(wcreate)      "init"
+set info(wcreate)      "Try to create each widget"
+set depd(method)       "init wcreate"
+set info(method)       "Try to call each public method of all widgets"
+set depd(config-state) "init wcreate method"
+set info(config-state) "Configuring -state of widgets"
+
+proc APITest:init {} {
+    global widCmd cmdNames auto_index testConfig
+
+    TestBlock api-1.1 {Find out all the widget classes} {
+	# (1) Stores all the Tix commands in the associative array 
+	#     cmdNames
+	#
+	foreach cmd [info commands tix*] {
+	    if [regexp : $cmd] {
+		continue
+	    }
+	    set cmdNames($cmd) ""
+	}
+
+	foreach name [array names auto_index "tix*:AutoLoad"] {
+	    if [regsub {:AutoLoad} $name "" cmd] {
+		set cmdNames($cmd) ""
+	    }
+	}
+
+	# (3). Don't want to mess with the console routines
+	#
+	foreach name [array names cmdNames] {
+	    if [string match tixCon* $name] {
+		catch {
+		    unset cmdNames($name)
+		}
+	    }
+	}
+
+	# (2) Find out the names of the widget creation commands
+	#
+	foreach cmd [lsort [array names cmdNames]] {
+	    if [info exists $cmd\(superClass\)] {
+		if {[set $cmd\(superClass\)] == ""} {
+		    continue
+		}
+	    }
+	    switch -regexp -- $cmd {
+		{(DoWhenIdle)|(:)} {
+		    continue
+		}
+	    }
+
+	    if [info exists err] {
+		unset err
+	    }
+
+	    catch {
+		auto_load $cmd
+	    }
+	    catch {
+		if {[uplevel #0 set $cmd\(isWidget\)] == 1} {
+		    if {$testConfig(VERBOSE) > 20} {
+			puts "Found widget class: $cmd"
+		    }
+		    set widCmd($cmd) ""
+		}
+	    }
+	}
+    }
+}
+
+proc APITest:wcreate {} {
+    global widCmd testConfig
+
+    TestBlock api-2 {Find out all the widget classes} {
+	foreach cls [lsort [array names widCmd]] {
+	    if {[uplevel #0 set $cls\(virtual\)] == 1} {
+		# This is a virtual base class. Skip it.
+		#
+		continue
+	    }
+
+	    TestBlock api-2.1-$cls "Create widget of class: $cls" {
+		$cls .c
+		if ![tixStrEq [winfo toplevel .c] .c] {
+		    pack .c -expand yes -fill both
+		}
+		update
+	    }
+
+	    TestBlock api-2.2-$cls "Widget Deletion" {
+		catch {
+		    destroy .c
+		}
+
+		frame .c
+		update idletasks
+		global .c
+		if {[info exists .c] && [array names .c] != "context"} {
+		    catch {
+			parray .c
+		    }
+		    catch {
+			puts [set .c]
+		    }
+		    error "widget record has not been deleted properly"
+		}
+	    }
+	    catch {
+		destroy .c
+	    }
+	}
+    }
+}
+
+proc APITest:method {} {
+    global widCmd testConfig
+
+    TestBlock api-3 {Call all the methods of a widget class} {
+
+	foreach cls [lsort [array names widCmd]] {
+	    if {[uplevel #0 set $cls\(virtual\)] == 1} {
+		continue
+	    }
+
+	    TestBlock api-3.1-$cls "Widget class: $cls" {
+		$cls .c
+
+		upvar #0 $cls classRec
+		foreach method [lsort $classRec(methods)] {
+		    TestBlock api-3.1.1 "method: $method" {
+			catch {
+			    .c $method
+			}
+		    }
+		}
+	    }
+	    catch {
+		destroy .c
+	    }
+	}
+    }
+}
+
+proc APITest:config-state {} {
+    global widCmd testConfig
+
+    TestBlock api-4 {Call the config-state method} {
+
+	foreach cls [lsort [array names widCmd]] {
+	    if {[uplevel #0 set $cls\(virtual\)] == 1} {
+		continue
+	    }
+
+	    $cls .c
+	    catch {
+		pack .c
+	    }
+	    if [catch {.c cget -state}] {
+		destroy .c
+		continue
+	    }
+
+	    if [tixStrEq $cls tixBalloon] {
+		destroy .c
+		continue
+	    }
+
+	    TestBlock api-4.1-$cls "Class: $cls" {
+		.c config -state disabled
+		Assert {[tixStrEq [.c cget -state] "disabled"]}
+		update
+		Assert {[tixStrEq [.c cget -state] "disabled"]}
+
+		.c config -state normal
+		Assert {[tixStrEq [.c cget -state] "normal"]}
+		update
+		Assert {[tixStrEq [.c cget -state] "normal"]}
+
+
+		.c config -state disabled
+		Assert {[tixStrEq [.c cget -state] "disabled"]}
+		.c config -state normal
+		Assert {[tixStrEq [.c cget -state] "normal"]}
+
+	    }
+	    catch {
+		destroy .c; update
+	    }
+	}
+    }
+}
+
+proc APITest {t {level 0}} {
+    global depd tested info
+
+    if {$level > 300} {
+	error "possibly circular dependency"
+    }
+
+    set tested(none)  1
+
+    if [info exist tested($t)] {
+	return
+    }
+    foreach dep $depd($t) {
+	if {![info exists tested($dep)]} {
+	    APITest $dep [expr $level + 1]
+	}
+    }
+
+    if {$t == "all"} {
+	set tested($t) 1
+	return
+    } else {
+	update
+	eval APITest:$t
+	set tested($t) 1
+    }
+}
+
+proc About {} {
+    return "Tix API Testing Suite"
+}
+
+proc Test {} {
+    global depd env
+
+    if [info exists env(APT_SUBSET)] {
+	set tests $env(APT_SUBSET)
+    } else {
+	set tests [array names depd]
+    }
+
+    foreach test $tests {
+	APITest $test
+    }
+}
+

tests/general/cmderror.tcl

@@ -0,0 +1,53 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: cmderror.tcl,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
+#
+# cmderror.tcl --
+#
+#	This program tests whether command handler errors are processed
+#	properly by the Tix toolkit.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing command handler errors are processed properly"
+}
+
+proc Test {} {
+    global cmdHandlerCalled
+
+    if {![string compare [info command tixCmdErrorHandler] ""]} {
+	if ![auto_load tixCmdErrorHandler] {
+	    TestAbort "toolkit error: procedure \"tixCmdErrorHandler\" not implemented"
+	}
+    }
+    rename tixCmdErrorHandler _default_tixCmdErrorHandler
+    proc tixCmdErrorHandler {msg} {
+	global cmdHandlerCalled
+	set cmdHandlerCalled 1
+    }
+
+    # We cause an error to occur in the -command handler of the combobox
+    # widget. Such an error shouldn't cause the operation to fail.
+    # See the programmer's documentation of tixCmdErrorHandler for details.
+    #
+    catch {
+	tixComboBox .c -command CmdNotFound
+	.c invoke
+	set cmdNotFailed 1
+    }
+    Assert {[info exists cmdNotFailed]}
+    Assert {[info exists cmdHandlerCalled]}
+
+    # Clean up
+    #
+    destroy .c
+    rename tixCmdErrorHandler ""
+    rename _default_tixCmdErrorHandler tixCmdErrorHandler
+    unset cmdHandlerCalled
+
+}

tests/general/combobox.tcl

@@ -0,0 +1,111 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: combobox.tcl,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
+#
+# combobox.tcl --
+#
+#	Tests the ComboBox widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing the ComboBox widget."
+}
+
+proc cbTest_Command {args} {
+    global cbTest_selected
+
+    set cbTest_selected [tixEvent value]
+}
+
+proc cbTest_ListCmd {w} {
+    global counter
+
+    incr counter
+
+    $w subwidget listbox delete 0 end
+    $w subwidget listbox insert end 0
+    $w subwidget listbox insert end 1
+    $w subwidget listbox insert end 2
+}
+
+
+proc Test {} {
+    global cbTest_selected
+
+    for {set dropdown 1} {$dropdown >= 0} {incr dropdown -1} {
+
+	TestBlock combo-1.1 {Config -value} {
+	    set w [tixComboBox .c -command cbTest_Command -dropdown $dropdown \
+		-editable true]
+	    pack $w
+	    update
+	    set val "Testing some value .."
+	    $w config -value $val
+	    Assert {[tixStrEq "$cbTest_selected" $val]}
+	}
+
+	TestBlock combo-1.2 {selection from listbox} {
+	    $w subwidget listbox insert end "entry 0"
+	    $w subwidget listbox insert end "entry 1"
+	    $w subwidget listbox insert end "entry 2"
+
+	    for {set x 0} {$x <= 2} {incr x} {
+		Click [$w subwidget arrow] 
+		update
+
+		if $dropdown {
+		    ClickListboxEntry [$w subwidget listbox] $x single
+		} else {
+		    ClickListboxEntry [$w subwidget listbox] $x single
+		    ClickListboxEntry [$w subwidget listbox] $x double
+		}
+		update
+
+		Assert {[tixStrEq "$cbTest_selected" "entry $x"]}
+	    }
+	}
+
+	TestBlock combo-1.3 {invokation by keyboard} {
+	    set val "Testing by key with \\ slashes"
+	    KeyboardString [$w subwidget entry] $val
+	    KeyboardEvent [$w subwidget entry] <Return>
+	    update
+
+	    Assert {[tixStrEq "$cbTest_selected" "$val"]}
+	}
+
+	catch {
+	    destroy $w
+	}
+    }
+
+    TestBlock combo-2.1 {-listcmd of ComboBox} {
+	global counter
+	set counter 0
+	tixComboBox .c -listcmd "cbTest_ListCmd .c"
+	pack .c -expand yes -fill both
+	update
+
+	Click [.c subwidget arrow]
+	update
+	Assert {$counter == 1}
+	Click [.c subwidget arrow]
+	update
+
+	Click [.c subwidget arrow]
+	update
+	Click [.c subwidget arrow]
+	update
+	Assert {$counter == 2}
+
+
+	Assert {[.c subwidget listbox get 0] == "0"}
+	Assert {[.c subwidget listbox get 1] == "1"}
+	Assert {[.c subwidget listbox get 2] == "2"}
+    }
+}

tests/general/dirbox.tcl

@@ -0,0 +1,285 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: dirbox.tcl,v 1.3 2004/03/28 02:44:57 hobbs Exp $
+#
+# dirbox.tcl --
+#
+#	Tests the DirSelectBox and DirSelectDialog widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing the DirSelectBox and DirSelectDialog widgets."
+}
+
+# Try to configure the directory of a widget and see if it satisfy all
+# the requirements:
+#
+#	1: Should return error for non-existant directory, preserving
+#	   the old directory
+#
+#	2: When given a non-normalized path, it should normalize it.
+#
+proc TestConfigDirectory {class spec pack} {
+    global errorInfo
+
+    set w .w
+
+    if [winfo exists $w] {
+	destroy $w
+    }
+
+    TestBlock config-dir-1.1 "Simple creating of $class" {
+	# Creation without the spec. The default value should be normalized
+	#
+
+	# The default value should always be an absolute path
+	#
+	$class .w
+	set value [$w cget $spec]
+	Assert {[tixFSIsNorm $value]} 0 cont
+    }
+    catch {
+	destroy .w
+    }
+
+    TestBlock config-dir-1.2 "Creation with arbitrary (perhaps invalid) path" {
+	foreach item [GetCases_FsNormDir] {
+	    if [info exists errorInfo] {
+		set errorInfo ""
+	    }
+
+	    set text    [lindex $item 0]
+	    set want    [lindex $item 1]
+	    set wanterr [lindex $item 2]
+
+	    set err [catch {
+		set w [$class .w $spec $text]
+		set got [$w cget -value]
+	    }]
+	    Assert {$err == $wanterr}
+	    if {!$err} {
+		set want [tixFSDisplayName $want]
+		Assert {[tixStrEq $want $got]}
+	    }
+
+	    catch {
+		destroy .w
+	    }
+	}
+    }
+
+    catch {
+	destroy .w
+    }
+
+    TestBlock config-dir-1.2 "Config with arbitrary (perhaps invalid) path" {
+	set w [$class .w]
+
+	foreach item [GetCases_FsNormDir] {
+	    if [info exists errorInfo] {
+		set errorInfo ""
+	    }
+
+	    set text    [lindex $item 0]
+	    set want    [lindex $item 1]
+	    set wanterr [lindex $item 2]
+
+	    set err [catch {
+		$w config $spec $text
+		set got [$w cget -value]
+	    }]
+	    Assert {$err == $wanterr}
+
+	    if $err {
+		# Should hold the previous -value
+		#
+		set value [$w cget $spec]
+		Assert {[tixFSIsNorm $value]} 0 cont
+	    } else {
+		set value [$w cget $spec]
+		Assert {[tixFSIsNorm $value]} 0 cont
+
+		set want [tixFSDisplayName $want]
+		Assert {[tixStrEq $want $got]}
+	    }
+
+	    if $pack {
+		pack $w -expand yes -fill both -padx 10 -pady 10
+		update idletasks
+	    }
+	}
+    }
+
+    catch {
+	destroy $w
+    }
+}
+
+proc TestRand {max} {
+    global testRandSeed
+
+    if ![info exists testRandSeed] {
+	set testRandSeed [expr [lindex [time {cd [pwd]}] 0] * 47 + 147]
+    }
+
+    set x [expr ($testRandSeed + 47) * [lindex [time {cd [pwd]}] 0]]
+    set x [expr $x + 7 * $max]
+    set testRandSeed [expr ($x % $max) + $max]
+
+    return [expr $testRandSeed % $max]
+}
+
+# TestHListWildClick --
+#
+#	Randomly click around an hlist widget
+#
+# Args:
+#	hlist:widget	The HList widget.
+#	mode:		Either "single" or "double", indicating which type
+#			of mouse click is desired.
+#	cmd:		Command to call after each click.
+#
+proc TestHListWildClick {hlist mode cmd} {
+    # The percentage chance that we sould traverse to a child node
+    #
+    set chance 40
+
+    for {set x 0} {$x < 10} {incr x} {
+	set node [$hlist info children ""]
+	if [tixStrEq $node ""] {
+	    return
+	}
+
+	while 1 {
+	    set ran [TestRand 100]
+	    if {$ran >= $chance} {
+		break
+	    }
+	    set children [$hlist info children $node]
+	    if [tixStrEq $children ""] {
+		break
+	    }
+	    set node [lindex $children [expr $ran % [llength $children]]]
+	}
+
+	TestBlock wild-click-1.1 "clicking \"$node\" of HList" {
+	    if {![regexp -nocase alex [$hlist info data $node]]} {
+		#
+		# dirty fix: "alex" may be an AFS mounted file. Reading this
+		# directory may start an FTP session, which may be slow like
+		# hell
+		#
+		ClickHListEntry $hlist $node $mode
+		eval $cmd [list $node]
+	    }
+	}
+    }
+}
+
+
+proc DirboxTest_Cmd {args} {
+    global dirboxTest_selected
+
+    set dirboxTest_selected [tixEvent value]
+}
+
+proc DirboxTest_Compare {isDirBox w h node} {
+    global dirboxTest_selected
+
+    set selFile [$h info data $node]
+
+    Assert {[tixStrEq "$dirboxTest_selected" "$selFile"]}
+    set dirboxTest_selected ""
+
+    if {$isDirBox} {
+	set entry [$w subwidget dircbx subwidget combo subwidget entry]
+	set entText [$entry get]
+	Assert {[tixStrEq "$entText" "$selFile"]}
+    }
+}
+
+proc Test {} {
+    global dirboxTest_selected
+
+    #------------------------------------------------------------
+    # (1) DirList
+    #------------------------------------------------------------
+
+    TestBlock dirbox-1.1 {Generic testing of tixDirList} {
+	TestConfigDirectory tixDirList -value 1
+    }
+
+    TestBlock dirbox-1.2 {Wild click on the hlist subwidget} {
+	set dirboxTest_selected ""
+	set w [tixDirList .c -command DirboxTest_Cmd]
+	set h [$w subwidget hlist]
+	pack $w -expand yes -fill both
+	TestHListWildClick $h double "DirboxTest_Compare 0 $w $h"
+    }
+    catch {
+	destroy $w
+    }
+
+    #------------------------------------------------------------
+    # (2) DirTree
+    #------------------------------------------------------------
+    
+    TestBlock dirbox-2.1 {Generic testing of tixDirTree} {
+#	TestConfigDirectory tixDirTree -value 1
+    }
+
+    TestBlock dirbox-2.2 {Wild click on the hlist subwidget} {
+	set dirboxTest_selected ""
+	set w [tixDirTree .c -command DirboxTest_Cmd]
+	set h [$w subwidget hlist]
+	pack $w -expand yes -fill both
+#	TestHListWildClick $h double "DirboxTest_Compare 0 $w $h"
+    }
+    catch {
+	destroy $w
+    }
+
+    #------------------------------------------------------------
+    # (3) DirBox
+    #------------------------------------------------------------
+
+    TestBlock dirbox-3.1 {Generic testing of tixDirSelectBox} {
+#	TestConfigDirectory tixDirSelectBox -value 1
+    }
+
+    TestBlock dirbox-3.2 {Wild click on the hlist subwidget} {
+	set dirboxTest_selected ""
+	set w [tixDirSelectBox .c -command DirboxTest_Cmd]
+	set h [$w subwidget dirlist subwidget hlist]
+	pack $w -expand yes -fill both
+#	TestHListWildClick $h double "DirboxTest_Compare 0 $w $h"
+    }
+    catch {
+	destroy $w
+    }
+
+    TestBlock dirbox-4.1 {-disablecallback option} {
+	global dirbox_called
+	tixDirList .c -command dirbox_callback
+	pack .c
+	set dirbox_called 0
+	.c config -disablecallback 1
+	.c config -value [pwd]
+	.c config -disablecallback 0
+	Assert {$dirbox_called == 0}
+    }
+    catch {
+	destroy .c
+    }
+}
+
+proc dirbox_callback {args} {
+    global dirbox_called
+    set dirbox_called 1
+}
+    

tests/general/draw.tcl

@@ -0,0 +1,26 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: draw.tcl,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
+#
+# draw.tcl --
+#
+#	Test the drawing functions in Tix.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Test the drawing functions in Tix."
+}
+
+proc Test {} {
+    TestBlock draw-1.1 {tixTmpLine} {
+	tixTmpLine 0 50 300 50	
+	tixTmpLine 0 50 300 50
+	tixTmpLine 0 50 300 50 .	
+	tixTmpLine 0 50 300 50 .
+    }
+}

tests/general/event0.tcl

@@ -0,0 +1,104 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: event0.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing the event emulation routines in the test suite"
+}
+
+proc TestEntry_Invoke {w} {
+    global testEntry_Invoked testEntry_value1
+
+    set testEntry_Invoked 1
+    set testEntry_value1 [$w get]
+}
+
+proc Test {} {
+    global foo
+    set foo 0
+
+    TestBlock event0-1.1 {Typing return in an entry widget} {
+	global testEntry_Invoked testEntry_value0 testEntry_value1
+
+	set testEntry_Invoked 0
+	entry .e -textvariable testEntry_value0
+	set testEntry_value0 "Entering some text ..."
+	bind .e <Return> "TestEntry_Invoke .e"
+	pack .e
+	update
+
+	KeyboardEvent .e <Return>
+	update
+	Assert {$testEntry_Invoked == 1}
+	Assert {$testEntry_value0 == $testEntry_value1}
+    }
+
+    TestBlock event0-1.2 {Typing characters in an entry widget} {
+	set testEntry_value0 ""
+	set val "Typing the keyboard ..."
+
+	focus .e
+	.e delete 0 end
+	update
+	KeyboardString .e $val
+	update
+	Assert {[tixStrEq "$testEntry_value0" "$val"]}
+    }
+
+    TestBlock event0-1.3 {Typing characters and slashes in an entry widget} {
+	set testEntry_value0 ""
+	set val "Typing the \\ keyboard ..."
+
+	focus .e
+	.e delete 0 end
+	KeyboardString .e $val
+	update
+	Assert {[tixStrEq "$testEntry_value0" "$val"]}
+
+	destroy .e
+    }
+
+    TestBlock event0-1.4 {Testing ClickListboxEntry} {
+	listbox .l -selectmode single
+	.l insert end "index 0"
+	.l insert end "index 1"
+	.l insert end "index 2"
+
+	pack .l; update
+
+	for {set x 0} {$x <= 2} {incr x} {
+	    ClickListboxEntry .l $x single
+	    update
+	    Assert {[.l index active] == $x}
+	    Assert {[.l curselection] == $x}
+	}
+
+	destroy .l
+	update
+    }
+
+    TestBlock event0-1.5 {Clicking a button} {
+	button .b -command "set foo 1"
+	pack .b; update
+
+	Click .b
+	Assert {$foo == 1}
+    }
+
+    TestBlock event0-1.6 {Drag and selecting a combobox} {
+	tixComboBox .c
+	.c insert end 10
+	.c insert end 10
+	.c insert end 10
+	.c insert end 10
+	.c insert end 10
+	pack .c; update
+
+	HoldDown [.c subwidget arrow]
+	Drag [.c subwidget listbox] 10 10
+	Release [.c subwidget listbox] 10 10
+	Release [.c subwidget arrow] -30 30
+
+	Assert {[.c cget -value] == "10"}
+    }
+}

tests/general/filebox.tcl

@@ -0,0 +1,137 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: filebox.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# filebox.tcl --
+#
+#	Tests the File selection box and dialog widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing the (Ex)FileSelectBox and (Ex)FileSelectDialog widgets."
+}
+
+proc FdTest_GetFile {args} {
+    global fdTest_selected
+
+    set fdTest_selected [tixEvent value]
+}
+
+proc Test {} {
+    global fdTest_fullPath
+
+    if [tixStrEq [tix platform] "unix"] {
+	set fdTest_fullPath /etc/passwd
+    } else {
+	set fdTest_fullPath C:\\Windows\\System.ini
+    }
+
+    Test_FileSelectBox
+    Test_FileSelectDialog
+
+    Test_ExFileSelectBox
+    Test_ExFileSelectDialog
+}
+
+proc Test_FileSelectBox {} {
+    global fdTest_selected fdTest_fullPath
+
+    TestBlock filebox-1.1 {FileSelectBox} {
+	set w [tixFileSelectBox .f -command FdTest_GetFile]
+	pack $w -expand yes -fill both
+	update
+
+	InvokeComboBoxByKey [$w subwidget selection] "$fdTest_fullPath"
+	Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+    }
+    catch {
+	destroy $w
+    }
+}
+
+proc Test_FileSelectDialog {} {
+    global fdTest_selected fdTest_fullPath
+
+    TestBlock filebox-2.1 {FileSelectDialog} {
+	set w [tixFileSelectDialog .f -command FdTest_GetFile]
+	$w popup
+	update
+
+	InvokeComboBoxByKey [$w subwidget fsbox subwidget selection] \
+	    "$fdTest_fullPath"
+	Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+    }
+    catch {
+	destroy $w
+    }
+}
+
+proc Test_ExFileSelectBox {} {
+    global fdTest_selected fdTest_fullPath
+
+    TestBlock filebox-3.1 {ExFileSelectBox} {
+	set w [tixExFileSelectBox .f -command FdTest_GetFile]
+	pack $w -expand yes -fill both
+	update
+
+	$w subwidget file config -selection "$fdTest_fullPath" \
+	    -value "$fdTest_fullPath"
+	Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+    }
+
+    TestBlock filebox-3.2 {Keyboard input in ExFileSelectBox entry subwidget} {
+	set dirCbx  [$w subwidget dir]
+	set fileCbx [$w subwidget file]
+	set okBtn   [$w subwidget ok]
+
+	foreach file {Foo bar "Foo Bar"} {
+	    set fdTest_selected ""
+
+	    InvokeComboBoxByKey $fileCbx $file
+	    set fullPath [tixFSJoin [$dirCbx cget -value] $file]
+	    update
+
+	    Assert {[tixStrEq "$fdTest_selected" "$fullPath"]}
+	}
+    }
+
+    TestBlock filebox-3.3 {Keyboard and then press OK} {
+	foreach file {bar "Foo Bar"} {
+	    set fdTest_selected ""
+
+	    SetComboBoxByKey $fileCbx $file
+	    Click $okBtn
+	    set fullPath [tixFSJoin [$dirCbx cget -value] $file]
+	    update
+
+	    Assert {[tixStrEq "$fdTest_selected" "$fullPath"]}
+	}
+    }
+
+    catch {
+	destroy $w
+    }
+}
+
+proc Test_ExFileSelectDialog {} {
+    global fdTest_selected fdTest_fullPath
+
+    TestBlock filebox-4.1 {ExFileSelectDialog} {
+	set w [tixExFileSelectDialog .f -command FdTest_GetFile]
+	$w popup
+	update
+
+	InvokeComboBoxByKey [$w subwidget fsbox subwidget file] \
+	    $fdTest_fullPath
+	Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+    }
+
+    catch {
+	destroy $w
+    }
+}

tests/general/files

@@ -0,0 +1,20 @@
+testtmpl.tcl
+api.tcl
+minterp.tcl
+options.tcl
+labentry.tcl
+event0.tcl
+fs.tcl
+oop.tcl
+optmenu.tcl
+select.tcl
+slistbox.tcl
+var1.tcl
+NoteBook.tcl
+mwm.tcl
+cmderror.tcl
+dirbox.tcl
+filebox.tcl
+combobox.tcl
+samples.tcl
+draw.tcl

tests/general/fs.tcl

@@ -0,0 +1,21 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: fs.tcl,v 1.4 2004/03/28 02:44:57 hobbs Exp $
+#
+# fs.tcl
+#
+# Test the portable file handling ("FS") routines.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing portable file handling routines"
+}
+
+proc Test {} {
+    # These tests were all obsolete post-Tix 8.2
+};            # Test

tests/general/labentry.tcl

@@ -0,0 +1,60 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: labentry.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# labentry.tcl
+#
+# Tests the TixLabelEntry widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing the TixLabelEntry widget"
+}
+
+proc Test {} {
+    TestBlock labent-1.1 {LabelEntry focus management} {
+        set t [toplevel .t]
+
+        set w [tixLabelEntry .t.c -label "Stuff(c): "]
+        pack $w -padx 20 -pady 10
+        tixLabelEntry .t.d -label "Stuff(d): "
+        pack .t.d -padx 20 -pady 10
+        focus $w
+        update
+
+        set px [winfo pointerx $t]
+        set py [winfo pointery $t]
+        set W [winfo width $t]
+        set H [winfo height $t]
+
+        if {$W < 100} {
+            set W 100
+        }
+        if {$H < 100} {
+            set H 100
+        }
+
+        set mx [expr $px - $W / 2]
+        set my [expr $py - $H / 2]
+
+        # We must move the window under the cursor in order to test
+        # the current focus
+        #
+        wm geometry $t $W\x$H+$mx+$my
+        raise $t
+        update
+
+        # On some platforms (e.g. Red Hat Linux 5.2/x86), this fails
+        # because we get: LHS = .t.c, RHS = .t.c.frame.entry
+        # (not clear why).
+        #
+        Assert {[focus -lastfor $t] == [$w subwidget entry]}
+
+        destroy $t
+    };    # TestBlock
+};        # Test

tests/general/minterp.tcl

@@ -0,0 +1,64 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: minterp.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# minterp.tcl
+#
+#	Tests Tix running under multiple interpreters.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Tests Tix running under multiple interpreters."
+}
+
+proc Test {} {
+    global tix tcl_version
+    if ![string comp [info commands interp] ""] {
+	# Does not support multiple interpreters.
+	return
+    }
+
+    if {[lsearch [package names] Itcl] != -1} {
+	#
+	# multiple interpreters currently core dumps under itcl2.1
+	#
+#	return
+    }
+
+    TestBlock minterp-1.1 {multiple interpreters} {
+	for {set x 0} {$x < 5} {incr x} {
+	    global testConfig
+	    interp create a
+	    interp eval a "set dynlib [list $testConfig(dynlib)]"
+	    if {[info exists tix(et)] && $tix(et) == 1} {
+		interp eval a {
+		    catch {load "" Tk}
+		    catch {load "" ITcl}
+		    catch {load "" ITk}
+		    catch {load "" Tclsam}
+		    catch {load "" Tksam}
+		    catch {load "" Tixsam}
+		}
+	    } else {
+		interp eval a {
+		    load "" Tk
+		    load $dynlib Tix
+		}
+	    }
+	    interp eval a {
+		tixControl .d -label Test
+		tixComboBox .e -label Test
+		tixDirList .l
+		pack .l	-expand yes -fill both
+		pack .d .e -expand yes -fill both
+		update
+	    }
+	    interp delete a
+	}
+    }
+}

tests/general/mwm.tcl

@@ -0,0 +1,50 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: mwm.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# mwm.tcl --
+#
+#	Test tixMwm command.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing tixMwm command"
+}
+
+proc Test {} {
+    if ![string compare [info command tixMwm] ""] {
+	puts "(OK) The tixMwm command is not available."
+	return
+    }
+    if ![tixMwm ismwmrunning .] {
+	puts "(OK) Mwm is not running on this display."
+	return
+    }
+    
+    toplevel .d
+    toplevel .e
+
+    test {tixMwm protocol .d add MY_PRINT_HELLO {"Print Hello"  _H Ctrl<Key>H}}
+    wm protocol .d MY_PRINT_HELLO {puts Hello}
+
+    test {tixMwm protocol .e add MY_PRINT_HELLO {"Print Hello"  _H Ctrl<Key>H}}
+    wm protocol .e MY_PRINT_HELLO {puts Hello}
+
+    test {destroy .d}
+
+    test {tixMwm protocol .e add MY_PRINT_HELLO {"Print Hello"  _H Ctrl<Key>H}}
+    wm protocol .e MY_PRINT_HELLO {puts Hello}
+
+    test {tixMwm protocol . delete MY_PRINT_HELLO}
+    wm protocol . MY_PRINT_HELLO {}
+
+    test {tixMwm protocol .e add MY_PRINT_HELLO {"Print Hello"  _H Ctrl<Key>H}}
+    wm protocol .e MY_PRINT_HELLO {puts Hello}
+
+    test {destroy .e}
+}

tests/general/oop.tcl

@@ -0,0 +1,15 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: oop.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing OOP features"
+}
+
+proc Test {} {
+    test {tix} {arg}
+    test {tixWidgetClass} {arg}
+    test {tixClass} {arg}
+    test {tixNoteBook} {arg}
+    test {tixAppContext} {arg}
+}

tests/general/options.tcl

@@ -0,0 +1,21 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: options.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing the option configuration of the Tix widgets"
+}
+
+proc Test {} {
+    test {tixComboBox .c -xxxxx} 	{missing}
+    test {tixComboBox .c -xxxxx xxx} 	{unknown}
+    test {tixComboBox .c -d xxx} 	{ambi}
+    test {tixComboBox .c -disab 0}	{ambi} 
+    test {tixComboBox .c -disablecal 0}
+    Assert {[.c cget -disablecallback] == 0}
+    Assert {[.c cget -disableca] == 0}
+    test {tixComboBox .d -histl 10} 
+    Assert {[.d cget -histlimit] == 10}
+    Assert {[.d cget -histlim] == 10}
+    Assert {[.d cget -historylimit] == 10}
+}

tests/general/optmenu.tcl

@@ -0,0 +1,109 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: optmenu.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing Option Menu widget"
+}
+
+proc Test {} {
+    tixOptionMenu .p -label "From File Format : " -command "selectproc input" \
+	-disablecallback 1 \
+	-options {
+	    label.width 19
+	    label.anchor e
+	    menubutton.width 15
+	}
+
+    pack .p
+
+    .p add command text   -label "Plain Text"
+    .p add command post   -label "PostScript"      
+    .p add command format -label "Formatted Text"  
+    .p add command html   -label "HTML"            
+    .p add separator sep
+    .p add command tex    -label "LaTeX"           
+    .p add command rtf    -label "Rich Text Format"
+
+    update
+
+    foreach ent [.p entries] {
+	test {.p delete $ent}
+    }
+
+    Assert {[.p subwidget menubutton cget -text] == {}}
+
+    test {destroy .p}
+
+    # Testing deleting "sep" at the end
+    #
+    tixOptionMenu .p -label "From File Format : " -command "selectproc input" \
+	-disablecallback 1 \
+	-options {
+	    label.width 19
+	    label.anchor e
+	    menubutton.width 15
+	}
+
+
+    pack .p
+
+    .p add command text   -label "Plain Text"
+    .p add command post   -label "PostScript"      
+    .p add command format -label "Formatted Text"  
+    .p add command html   -label "HTML"            
+    .p add separator sep
+    .p add command tex    -label "LaTeX"           
+    .p add command rtf    -label "Rich Text Format"
+
+    test {.p delete text}
+    test {.p delete post}
+    test {.p delete html}
+    test {.p delete format}
+    test {.p delete tex}
+    test {.p delete rtf}
+    test {.p delete sep}
+
+    Assert {[.p subwidget menubutton cget -text] == {}}
+    test {destroy .p}
+
+    # Testing deleting "sep" as the second-last one
+    #
+    tixOptionMenu .p -label "From File Format : " -command "selectproc input" \
+	-disablecallback 1 \
+	-options {
+	    label.width 19
+	    label.anchor e
+	    menubutton.width 15
+	}
+
+
+    pack .p
+
+    .p add command text   -label "Plain Text"
+    .p add command post   -label "PostScript"      
+    .p add command format -label "Formatted Text"  
+    .p add command html   -label "HTML"            
+    .p add separator sep
+    .p add command tex    -label "LaTeX"           
+    .p add command rtf    -label "Rich Text Format"
+
+    test {.p delete text}
+    global .p
+    Assert {[info exists .p(text,type)] == 0}
+    Assert {[info exists .p(text,name)] == 0}
+    Assert {[info exists .p(text,label)] == 0}
+    test {.p delete post}
+    test {.p delete html}
+    test {.p delete format}
+    test {.p delete tex}
+
+    Assert {[.p cget -value] == "rtf"}
+    test {.p delete sep}
+    Assert {[.p cget -value] == "rtf"}
+    test {.p delete rtf}
+
+    Assert {[.p subwidget menubutton cget -text] == {}}
+
+    test {destroy .p}
+}

tests/general/pane.tcl

@@ -0,0 +1,33 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: pane.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# pane.tcl --
+#
+#	Test the PanedWindow widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Test the PanedWindow widget."
+}
+
+proc Test {} {
+    TestBlock pane-1.1 {tixPanedWindow -expand} {
+	tixPanedWindow .p -orient horizontal
+	pack .p -expand yes -fill both
+	set p1 [.p add pane1 -expand 0.3]
+	set p2 [.p add pane2 -expand 1]
+	set p3 [.p add pane3 -size 20]
+	.p config -width 300 -height 200
+	update
+	.p config -width 500
+	update
+	.p config -width 200
+	update
+    }
+}

tests/general/pkginit.tcl

@@ -0,0 +1,10 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: pkginit.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# pkginit.tcl --
+#
+#
+#	This file contains the initialization code for all the test programs
+#	in this directory.
+#	

tests/general/samples.tcl

@@ -0,0 +1,77 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: samples.tcl,v 1.3 2002/11/13 21:12:18 idiscovery Exp $
+#
+# samples.tcl --
+#
+#	Tests all the sample programs in the demo/samples directory.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing all the sample programs in the demo/samples directory"
+}
+
+proc Test {} {
+    global samples_dir demo_dir tix_library
+
+    TestBlock samples-1.0 "Finding the demo directory" {
+	foreach dir "$tix_library/demos $tix_library/../demos ../../demos ../demos demos" {
+	    if {[file exists $dir] && [file isdir $dir]} {
+		set pwd [pwd]
+		cd $dir
+		set demo_dir    [pwd]
+		set samples_dir [pwd]/samples
+		cd $pwd
+		break
+	    }
+	}
+    }
+
+    if {![info exists samples_dir]} {
+	puts "Cannot find demos directory. Sample tests are skipped"
+	return
+    } else {
+	puts "loading demos from $demo_dir"
+    }
+
+    TestBlock samples-1.1 "Running widget demo" {
+	if {[file exists [set file [file join $demo_dir tixwidgets.tcl]]]} {
+	    uplevel #0 [list source $file]
+	    tixDemo:SelfTest
+	}
+    }
+    if {![file exists [set file [file join $samples_dir AllSampl.tcl]]]} {
+	return
+    }
+    uplevel #0 [list source $file]
+
+    ForAllSamples root "" Test_Sample
+}
+
+
+proc Test_Sample {token type text dest} {
+    global samples_dir tix_demo_running 
+
+    set tix_demo_running 1
+
+    if {$type == "f"} {
+	set w .sampl_top
+	TestBlock samples-2-$dest "Loading sample $dest" {
+	    uplevel #0 source [list $samples_dir/$dest]
+	    toplevel $w
+	    wm geometry $w +100+100
+	    wm title $w $text
+	    RunSample $w
+	    update
+	}
+	catch {
+	    destroy $w
+	}
+    }
+}

tests/general/select.tcl

@@ -0,0 +1,49 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: select.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing the TixSelect widget"
+}
+
+proc Test {} {
+    set dis  [tix option get disabled_fg]
+    set norm [tix option get fg]
+
+    # Create with a normal state
+    #
+    #
+    tixSelect .foo -allowzero 0 -radio 1 -label "Foo:" \
+	-state normal
+    .foo add "1" -text "One"
+    .foo add "2" -text "Two"
+    pack .foo
+
+    Assert {[.foo subwidget label cget -foreground] == $norm}
+    .foo config -state normal
+    .foo config -state normal
+    Assert {[.foo subwidget label cget -foreground] == $norm}
+    .foo config -state disabled
+    Assert {[.foo subwidget label cget -foreground] == $dis}
+    .foo config -state normal
+    Assert {[.foo subwidget label cget -foreground] == $norm}
+
+    update
+    destroy .foo
+
+    tixSelect .foo -allowzero 0 -radio 1 -label "Foo:" \
+	-state disabled
+    .foo add "1" -text "One"
+    .foo add "2" -text "Two"
+    pack .foo
+
+    Assert {[.foo subwidget label cget -foreground] == $dis}
+    .foo config -state normal
+    Assert {[.foo subwidget label cget -foreground] == $norm}
+    .foo config -state normal
+    Assert {[.foo subwidget label cget -foreground] == $norm}
+    .foo config -state disabled
+    Assert {[.foo subwidget label cget -foreground] == $dis}
+    .foo config -state normal
+    Assert {[.foo subwidget label cget -foreground] == $norm}
+}

tests/general/slistbox.tcl

@@ -0,0 +1,20 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: slistbox.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing ScrolledListBox"
+}
+
+proc Test {} {
+    set w [tixScrolledListBox .listbox]
+    pack $w
+
+    foreach item {{1 1} 2 3 4 5 6} {
+	$w subwidget listbox insert end $item
+    }
+
+    Click [$w subwidget listbox] 30 30
+
+    destroy $w
+}

tests/general/testtmpl.tcl

@@ -0,0 +1,32 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: testtmpl.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+# testtmpl.tcl --
+#
+#	Test Template:
+#
+#	This program is used as the first test: see whether we can execute any
+#	case at all.
+#
+#	This program is also used as a template file for writing other test
+#	cases.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+    return "Testing whether the test program starts up properly"
+}
+
+proc Test {} {
+    TestBlock testtmpl-1.1 {NULL test} {
+	#
+	# If this fails, we are in big trouble and probably none of the
+	# tests can pass. Abort all the tests
+	#
+    } 1 abortall
+}

tests/general/var1.tcl

@@ -0,0 +1,63 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+#
+#	$Id: var1.tcl,v 1.2 2002/11/13 21:12:18 idiscovery Exp $
+#
+proc About {} {
+    return "Testing -variable option with Tix widgets"
+}
+
+proc Test {} {
+    global foo bar arr
+
+    set classes {tixControl tixComboBox}
+    set value 1234
+
+    foreach class $classes {
+	set w [$class .foo]
+	pack $w
+	update idletasks
+
+	TestBlock var1-1.1 {$class: config -variable with initialized value} {
+	    set bar $value
+	    $w config -variable bar
+	    update idletasks
+	    Assert {[$w cget -value] == $value}
+	}
+
+	TestBlock var1-1.2 {$class: config -variable w/ uninitialized value} {
+	    destroy $w
+	    set w [$class .foo]
+	    $w config -variable bar
+	    Assert {[$w cget -value] == $bar}
+	}
+
+	TestBlock var1-1.2 {$class: config -variable} {
+	    set foo 111
+	    $w config -variable foo
+	    update idletasks
+	    Assert {[$w cget -value] == $foo}
+	}
+
+	TestBlock var1-1.2 {$class: config -value} {
+	    $w config -value 123
+	    Assert {[$w cget -value] == 123}
+	    Assert {[set [$w cget -variable]] == 123}
+	}
+
+	TestBlock var1-1.2 {$class: config -variable on array variable} {
+	    set arr(12) 1234
+	    $w config -variable arr(12)
+	    Assert {[$w cget -value] == $arr(12)}
+	}
+
+	TestBlock var1-1.2 {$class: config -value on array variable} {
+	    $w config -value 12
+	    Assert {[$w cget -value] == 12}
+	    Assert {[set [$w cget -variable]] == 12}
+	}
+
+	catch {
+	    destroy $w
+	}
+    }
+}