summaryrefslogtreecommitdiff
path: root/iwidgets/tests/scrolledcanvas.test
diff options
context:
space:
mode:
Diffstat (limited to 'iwidgets/tests/scrolledcanvas.test')
-rw-r--r--iwidgets/tests/scrolledcanvas.test194
1 files changed, 194 insertions, 0 deletions
diff --git a/iwidgets/tests/scrolledcanvas.test b/iwidgets/tests/scrolledcanvas.test
new file mode 100644
index 00000000000..ccb929ce99b
--- /dev/null
+++ b/iwidgets/tests/scrolledcanvas.test
@@ -0,0 +1,194 @@
+# This file is a Tcl script to test out [incr Widgets] ScrolledListBox 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 Scrolledcanvas-1.$c {Scrolledcanvas construction} {
+ iwidgets::Scrolledcanvas .sc
+ pack .sc -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Scrolledcanvas-2.$o {configuration option} {
+ llength [.sc configure]
+} {45}
+
+incr o
+
+foreach test {
+ {-automargin 15 15}
+ {-autoresize 0 0}
+ {-autoresize 1 1}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-closeenough 1.0 1.0}
+ {-confine 1 1}
+ {-cursor gumby gumby}
+ {-height 200 200}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-labelfont 6x13 6x13}
+ {-labeltext scrolledcanvas scrolledcanvas}
+ {-labelmargin 3 3}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-sbwidth 15 15}
+ {-xscrollincrement 10 10}
+ {-yscrollincrement 10 10}
+ {-scrollmargin 3 3}
+ {-scrollregion {0 0 0 0} {0 0 0 0}}
+ {-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}
+ {-textbackground GhostWhite GhostWhite}
+ {-vscrollmode static static}
+ {-vscrollmode none none}
+ {-vscrollmode dynamic dynamic}
+ {-width 200 200}} {
+ set option [lindex $test 0]
+ test Scrolledcanvas-2.$o "configuration options, $option" {
+ .sc configure $option [lindex $test 1]
+ lindex [.sc configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Scrolledcanvas-2.$o "configuration options, $option" {
+ list [catch {.sc configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sc create rectangle 100 100 400 400 -fill red} {1}}
+ {{.sc create rectangle 300 300 600 600 -fill green} {2}}
+ {{.sc create rectangle 200 200 500 500 -fill blue} {3}}
+ {{.sc bbox 1} {99 99 401 401}}
+ {{.sc coords 2} {300.0 300.0 600.0 600.0}}
+ {{.sc delete 3} {}}
+ {{.sc move 1 10 10} {}}
+ {{.sc scale 1 100 100 0.8 0.8} {}}
+ {{.sc xview moveto 0} {}}
+ {{.sc yview moveto 0} {}}
+ {{.sc childsite} {.sc.lwchildsite.clipper.canvas}}
+ {{.sc justify left} {}}
+ {{.sc justify right} {}}
+ {{.sc justify top} {}}
+ {{.sc justify bottom} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledcanvas-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 Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
+ destroy .sc
+ update
+} {}
+
+incr c
+
+test Scrolledcanvas-1.$c {Scrolledcanvas construction} {
+ iwidgets::Scrolledcanvas .sc -autoresize no -labelpos nw \
+ -vscrollmode static -hscrollmode dynamic -labeltext "Scrolledcanvas"
+ pack .sc -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
+ destroy .sc
+ update
+} {}
+
+incr c
+
+test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
+ iwidgets::scrolledcanvas .sc
+ pack .sc
+ destroy .sc
+ update
+} {}
+
+::tcltest::cleanupTests
+exit