itcl/iwidgets/tests/pushbutton.test

   1 # This file is a Tcl script to test out [incr Widgets] Pushbutton class.
   2 # It is organized in the standard fashion for Tcl tests with the following
   3 # notation for test case labels:
   4 #
   5 #   1.x - Construction/Destruction tests
   6 #   2.x - Configuration option tests
   7 #   3.x - Method tests
   8 #
   9 # Copyright (c) 1995 DSC Technologies Corporation
  10 #
  11 # See the file "license.terms" for information on usage and redistribution
  12 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13 #
  14 # @(#) $Id$
  15
  16 package require tcltest
  17 namespace import -force ::tcltest::*
  18
  19 if [catch {package require Iwidgets 4.0}] {
  20   # Let's try modifying the auto_path.  Note that the IWIDGETS_LIBRARY
  21   # env var is initialized in the Makefile when doing a 'make test'.
  22   # If sourcing this file independently, this variable must be set manually.
  23   if ![info exists env(IWIDGETS_LIBRARY)] {
  24     error "Unable to locate Iwidgets package.  Set your IWIDGETS_LIBRARY\
  25       environment\nvariable to the directory that contains iwidgets.tcl"
  26   }
  27   lappend auto_path $env(IWIDGETS_LIBRARY)
  28   package require Iwidgets 4.0
  29 }
  30
  31 if {[string compare test [info procs test]] == 1} {
  32     source defs
  33 }
  34
  35 wm geometry . {}
  36 raise .
  37
  38 set c 1
  39 set o 1
  40 set m 1
  41
  42 #
  43 # Initial construction test
  44 #
  45 test Pushbutton-1.$c {Pushbutton construction} {
  46     iwidgets::Pushbutton .pb
  47     pack .pb -padx 10 -pady 10
  48     image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
  49     update
  50 } {}
  51
  52 incr c
  53
  54 #
  55 # Option tests which are successful.
  56 #
  57 test Pushbutton-2.$o {configuration option} {
  58     llength [.pb configure]
  59 } {27}
  60
  61 incr o
  62
  63 foreach test {
  64         {-activebackground #ececec #ececec}
  65         {-activeforeground Black Black}
  66         {-background #d9d9d9 #d9d9d9}
  67         {-borderwidth 2 2}
  68         {-command {.pb configure -background Red} {.pb configure -background Red}}
  69         {-defaultring 1 1}
  70         {-text Hello Hello}
  71         {-width 100 100}
  72         {-bitmap error error}
  73         {-image flagup flagup}
  74         {-defaultring 0 0}
  75         {-padx 10 10}
  76         {-padx 8 8}
  77         {-pady 8 8}
  78         {-pady 4 4}
  79         {-image {} {}}
  80         {-cursor gumby gumby}
  81         {-bitmap {} {}}
  82         {-font 6x13 6x13}
  83         {-foreground Black Black}
  84         {-height 70 70}
  85         {-width 100 100}
  86         {-underline 0 0}
  87         {-highlightthickness 3 3}
  88         {-highlightcolor blue blue}
  89         {-highlightcolor black black}
  90         {-highlightthickness 2 2}
  91         {-state disabled disabled}
  92         {-state normal normal}
  93         {-defaultringpad 6 6}
  94         {-width 120 120}} {
  95         set option [lindex $test 0]
  96         test Pushbutton-2.$o "configuration options, $option" {
  97             .pb configure $option [lindex $test 1]
  98             lindex [.pb configure $option] 4
  99         } [lindex $test 2]
 100         update
 101         incr o
 102 }
 103
 104 #
 105 # Method tests which are successful.
 106 #
 107 foreach test {
 108     {{.pb flash} {}}
 109     {{.pb invoke} {}}} {
 110         set method [lindex [lindex $test 0] 1]
 111         test Pushbutton-3.$m "object methods, $method" {
 112             list [catch {eval [lindex $test 0]} msg] $msg
 113         } [list 0 [lindex $test 1]]
 114         update
 115         incr m
 116 }
 117
 118 #
 119 # Conclusion of constrcution/destruction tests
 120 #
 121 test Pushbutton-1.$c {Pushbutton destruction} {
 122     destroy .pb
 123     update
 124     image delete flagup
 125 } {}
 126
 127 incr c
 128
 129 test Pushbutton-1.$c {Pushbutton construction} {
 130     iwidgets::pushbutton .pb -text "Push Button" -defaultring yes
 131     pack .pb -padx 10 -pady 10
 132     update
 133 } {}
 134
 135 incr c
 136
 137 test Pushbutton-1.$c {Pushbutton destruction} {
 138     destroy .pb
 139     update
 140 } {}
 141
 142 incr c
 143
 144 test Pushbutton-1.$c {Pushbutton destruction} {
 145     iwidgets::pushbutton .pb
 146     pack .pb
 147     destroy .pb
 148     update
 149 } {}
 150
 151 ::tcltest::cleanupTests
 152 exit