Import Tix 8.4.3.5 (as of svn r86089)

tests/itcl.test

@@ -0,0 +1,91 @@
+# -*- mode: TCL; fill-column: 75; tab-width: 8; coding: iso-latin-1-unix -*-
+# itcl.test --
+#
+#       This file tests interaction between Tix and [incr tcl]/[incr tk].
+#       It is organized in the standard fashion for Tcl
+#       tests.
+#
+# Copyright (c) 2000-2001 Tix Project Group.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# $Id: itcl.test,v 1.2 2002/11/13 21:12:17 idiscovery Exp $
+
+package require Tix
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+if {[catch {package require Itcl} msg] || [catch {package require Itk} msg]} {
+    puts "itcl/itk not installed on your system: $msg"
+    puts "tests in [info script] skipped"
+    ::tcltest::cleanupTests
+    return
+}
+
+test itcl-1.1 {variable scope} {
+    # Tests:
+    #     - Creating a tix widget inside the scope of an itcl method
+    #     - Sharing global variable with itcl
+    itcl::class ::foo {
+        inherit itk::Widget
+
+        constructor {args} {
+	    itk_component add lab {
+		label $itk_interior.lab \
+		    -textvariable ::choice($this)
+	    }
+
+	    itk_component add tixwidget {
+		tixOptionMenu $itk_interior.tixwidget \
+		    -label "File format" \
+		    -variable ::choice($this) \
+		    -command "$this foocmd"
+	    }
+
+	    foreach cmd {HTML PostScript ASCII} {
+		$itk_component(tixwidget) add command $cmd
+	    }
+
+	    pack $itk_component(lab) $itk_component(tixwidget) \
+		-anchor e \
+		-padx 10 \
+		-pady 10 \
+		-fill x
+
+	    eval itk_initialize $args
+        }
+        common choice
+
+	method foocmd {args} {
+	    #puts $args
+	}
+        method set_format {format} {
+	    set ::choice($this) $format
+        }
+    }
+    itk::usual TixOptionMenu {
+    }
+
+    foo .xy
+    pack .xy
+
+    .xy set_format ASCII
+    lappend list $choice(::.xy)
+
+    .xy component tixwidget config -value PostScript
+    lappend list $choice(::.xy)
+
+    .xy component tixwidget config -value HTML
+    lappend list $choice(::.xy)
+
+    set list
+} {ASCII PostScript HTML}
+
+
+# cleanup
+::tcltest::cleanupTests
+return
+