diff options
Diffstat (limited to 'itcl/iwidgets/tests/labeledwidget.test')
| -rw-r--r-- | itcl/iwidgets/tests/labeledwidget.test | 172 |
1 files changed, 172 insertions, 0 deletions
diff --git a/itcl/iwidgets/tests/labeledwidget.test b/itcl/iwidgets/tests/labeledwidget.test new file mode 100644 index 00000000000..0ef8fdaee88 --- /dev/null +++ b/itcl/iwidgets/tests/labeledwidget.test @@ -0,0 +1,172 @@ +# This file is a Tcl script to test out [incr Widgets] Labeledwidget 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 Labeledwidget-1.$c {Labeledwidget construction} { + iwidgets::Labeledwidget .lw + pack [listbox [.lw childsite].lb -relief sunken] -padx 10 -pady 10 + pack .lw -fill both -expand yes -padx 10 -pady 10 + image create bitmap flagup -file $tk_library/demos/images/flagup.bmp + update +} {} + +incr c + +# +# Option tests which are successful. +# +test Labeledwidget-2.$o {configuration option} { + llength [.lw configure] +} {14} + +incr o + +foreach test { + {-labelvariable foo foo} + {-labelvariable {} {}} + {-labeltext "Label" "Label"} + {-labelpos nw nw} + {-labelpos n n} + {-labelpos ne ne} + {-labelpos en en} + {-labelpos e e} + {-labelpos es es} + {-labelpos sw sw} + {-labelpos s s} + {-labelpos se se} + {-labelpos wn wn} + {-labelpos w w} + {-labelpos ws ws} + {-labelmargin 20 20} + {-labelfont 6x13 6x13} + {-labelimage flagup flagup} + {-labelpos nw nw} + {-labelpos n n} + {-labelpos ne ne} + {-labelpos en en} + {-labelpos e e} + {-labelpos es es} + {-labelpos sw sw} + {-labelpos s s} + {-labelpos se se} + {-labelpos wn wn} + {-labelpos w w} + {-labelpos ws ws} + {-sticky w w} + {-sticky nw nw} + {-sticky n n} + {-sticky ne ne} + {-sticky e e} + {-sticky se se} + {-sticky s s} + {-sticky sw sw} + {-sticky news news} + {-labelimage {} {}}} { + set option [lindex $test 0] + test Labeledwidget-1.$o "configuration options, $option" { + .lw configure $option [lindex $test 1] + lindex [.lw configure $option] 4 + } [lindex $test 2] + update + incr o + } + +# +# Method tests which are successful. +# +test Labeledwidget-3.$m {object method, childsite} { + list [catch {.lw childsite} msg] $msg +} [list 0 .lw.lwchildsite] + +incr m + +test Labeledwidget-3.$m {object static method, alignlabels} { + list [catch {iwidgets::Labeledwidget::alignlabels .lw} msg] $msg +} {0 {}} + +incr m + +# +# Method tests which fail and produce errors +# +test Labeledwidget-3.$m {alignlabels static method} { + button .b + list [catch {iwidgets::Labeledwidget::alignlabels .b} msg] $msg +} {1 {.b is not a "Labeledwidget"}} + +incr m + +test Labeledwidget-1.$c {Labeledwidget destruction} { + destroy .b + destroy .lw + update + image delete flagup +} {} + +incr c + +test Labeledwidget-1.$c {Labeledwidget construction} { + iwidgets::labeledwidget .lw -labeltext "ListBox" -labelpos s + pack [listbox [.lw childsite].lb -relief sunken] -padx 10 -pady 10 + pack .lw -fill both -expand yes -padx 10 -pady 10 + update +} {} + +incr c + +test Labeledwidget-1.$c {Labeledwidget destruction} { + destroy .lw + update +} {} + +incr c + +test Labeledwidget-1.$c {Labeledwidget construction} { + iwidgets::labeledwidget .lw + pack .lw + destroy .lw + update +} {} + +::tcltest::cleanupTests +exit |