Enable to track git://github.com/monaka/binutils.git

[pf3gnuchains/pf3gnuchains3x.git] / itcl / iwidgets / tests / pushbutton.test

diff --git a/itcl/iwidgets/tests/pushbutton.test b/itcl/iwidgets/tests/pushbutton.test
new file mode 100644 (file)
index 0000000..b2bc848
--- /dev/null
+++ b/itcl/iwidgets/tests/pushbutton.test
@@ -0,0 +1,152 @@
+# This file is a Tcl script to test out [incr Widgets] Pushbutton 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$
+
+package require tcltest
+namespace import -force ::tcltest::*
+
+if [catch {package require Iwidgets 4.0}] {
+  # Let's try modifying the auto_path.  Note that the IWIDGETS_LIBRARY
+  # env var is initialized in the Makefile when doing a 'make test'.
+  # If sourcing this file independently, this variable must be set manually.
+  if ![info exists env(IWIDGETS_LIBRARY)] {
+    error "Unable to locate Iwidgets package.  Set your IWIDGETS_LIBRARY\
+      environment\nvariable to the directory that contains iwidgets.tcl"
+  }
+  lappend auto_path $env(IWIDGETS_LIBRARY)
+  package require Iwidgets 4.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 Pushbutton-1.$c {Pushbutton construction} {
+    iwidgets::Pushbutton .pb 
+    pack .pb -padx 10 -pady 10
+    image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
+    update 
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Pushbutton-2.$o {configuration option} {
+    llength [.pb configure]
+} {27}
+
+incr o
+
+foreach test {
+       {-activebackground #ececec #ececec}
+       {-activeforeground Black Black} 
+       {-background #d9d9d9 #d9d9d9}
+        {-borderwidth 2 2}
+       {-command {.pb configure -background Red} {.pb configure -background Red}}
+       {-defaultring 1 1} 
+       {-text Hello Hello}
+       {-width 100 100}
+       {-bitmap error error} 
+       {-image flagup flagup}
+       {-defaultring 0 0} 
+       {-padx 10 10} 
+       {-padx 8 8} 
+       {-pady 8 8} 
+       {-pady 4 4} 
+       {-image {} {}}
+       {-cursor gumby gumby} 
+       {-bitmap {} {}}
+       {-font 6x13 6x13} 
+       {-foreground Black Black} 
+       {-height 70 70} 
+       {-width 100 100}
+       {-underline 0 0}
+       {-highlightthickness 3 3}
+       {-highlightcolor blue blue} 
+       {-highlightcolor black black} 
+       {-highlightthickness 2 2}
+       {-state disabled disabled} 
+       {-state normal normal} 
+        {-defaultringpad 6 6}
+       {-width 120 120}} {
+       set option [lindex $test 0]
+       test Pushbutton-2.$o "configuration options, $option" {
+           .pb configure $option [lindex $test 1]
+           lindex [.pb configure $option] 4
+       } [lindex $test 2]
+       update 
+       incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+    {{.pb flash} {}}
+    {{.pb invoke} {}}} {
+       set method [lindex [lindex $test 0] 1]
+       test Pushbutton-3.$m "object methods, $method" {
+           list [catch {eval [lindex $test 0]} msg] $msg
+       } [list 0 [lindex $test 1]]
+       update 
+       incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Pushbutton-1.$c {Pushbutton destruction} {
+    destroy .pb
+    update 
+    image delete flagup
+} {}
+
+incr c
+
+test Pushbutton-1.$c {Pushbutton construction} {
+    iwidgets::pushbutton .pb -text "Push Button" -defaultring yes 
+    pack .pb -padx 10 -pady 10 
+    update 
+} {}
+
+incr c
+
+test Pushbutton-1.$c {Pushbutton destruction} {
+    destroy .pb
+    update 
+} {}
+
+incr c
+
+test Pushbutton-1.$c {Pushbutton destruction} {
+    iwidgets::pushbutton .pb
+    pack .pb
+    destroy .pb
+    update 
+} {}
+
+::tcltest::cleanupTests
+exit