itcl/iwidgets/tests/scrolledcanvas.test

   1 # This file is a Tcl script to test out [incr Widgets] ScrolledListBox 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 Scrolledcanvas-1.$c {Scrolledcanvas construction} {
  46     iwidgets::Scrolledcanvas .sc
  47     pack .sc -padx 10 -pady 10 -fill both -expand yes
  48     update
  49 } {}
  50
  51 incr c
  52
  53 #
  54 # Option tests which are successful.
  55 #
  56 test Scrolledcanvas-2.$o {configuration option} {
  57     llength [.sc configure]
  58 } {45}
  59
  60 incr o
  61
  62 foreach test {
  63     {-automargin 15 15}
  64     {-autoresize 0 0}
  65     {-autoresize 1 1}
  66     {-background #d9d9d9 #d9d9d9}
  67     {-borderwidth 2 2}
  68     {-closeenough 1.0 1.0}
  69     {-confine 1 1}
  70     {-cursor gumby gumby}
  71     {-height 200 200}
  72     {-hscrollmode none none}
  73     {-hscrollmode static static}
  74     {-hscrollmode dynamic dynamic}
  75     {-labelfont 6x13 6x13}
  76     {-labeltext scrolledcanvas scrolledcanvas}
  77     {-labelmargin 3 3}
  78     {-labelpos nw nw}
  79     {-labelpos ne ne}
  80     {-labelpos en en}
  81     {-labelpos e e}
  82     {-labelpos es es}
  83     {-labelpos se se}
  84     {-labelpos s s}
  85     {-labelpos sw sw}
  86     {-labelpos wn wn}
  87     {-labelpos w w}
  88     {-labelpos ws ws}
  89     {-labelpos n n}
  90     {-relief raised raised}
  91     {-relief sunken sunken}
  92     {-sbwidth 15 15}
  93     {-xscrollincrement 10 10}
  94     {-yscrollincrement 10 10}
  95     {-scrollmargin 3 3}
  96     {-scrollregion {0 0 0 0} {0 0 0 0}}
  97     {-sticky w w}
  98     {-sticky nw nw}
  99     {-sticky n n}
 100     {-sticky ne ne}
 101     {-sticky e e}
 102     {-sticky se se}
 103     {-sticky s s}
 104     {-sticky sw sw}
 105     {-sticky news news}
 106     {-textbackground GhostWhite GhostWhite}
 107     {-vscrollmode static static}
 108     {-vscrollmode none none}
 109     {-vscrollmode dynamic dynamic}
 110     {-width 200 200}} {
 111         set option [lindex $test 0]
 112         test Scrolledcanvas-2.$o "configuration options, $option" {
 113             .sc configure $option [lindex $test 1]
 114             lindex [.sc configure $option] 4
 115         } [lindex $test 2]
 116         update
 117         incr o
 118 }
 119
 120 #
 121 # Option tests which fail and produce errors.
 122 #
 123 foreach test {
 124   {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
 125   {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} {
 126         set option [lindex $test 0]
 127         test Scrolledcanvas-2.$o "configuration options, $option" {
 128             list [catch {.sc configure $option [lindex $test 1]} msg] $msg
 129         } [list 1 [lindex $test 2]]
 130         incr o
 131 }
 132
 133 #
 134 # Method tests which are successful.
 135 #
 136 foreach test {
 137     {{.sc create rectangle 100 100 400 400 -fill red} {1}}
 138     {{.sc create rectangle 300 300 600 600 -fill green} {2}}
 139     {{.sc create rectangle 200 200 500 500 -fill blue} {3}}
 140     {{.sc bbox 1} {99 99 401 401}}
 141     {{.sc coords 2} {300.0 300.0 600.0 600.0}}
 142     {{.sc delete 3} {}}
 143     {{.sc move 1 10 10} {}}
 144     {{.sc scale 1 100 100 0.8 0.8} {}}
 145     {{.sc xview moveto 0} {}}
 146     {{.sc yview moveto 0} {}}
 147     {{.sc childsite} {.sc.lwchildsite.clipper.canvas}}
 148     {{.sc justify left} {}}
 149     {{.sc justify right} {}}
 150     {{.sc justify top} {}}
 151     {{.sc justify bottom} {}}} {
 152         set method [lindex [lindex $test 0] 1]
 153         test Scrolledcanvas-3.$m "object methods, $method" {
 154             list [catch {eval [lindex $test 0]} msg] $msg
 155         } [list 0 [lindex $test 1]]
 156         update
 157         incr m
 158 }
 159
 160 #
 161 # Conclusion of constrcution/destruction tests
 162 #
 163 test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
 164     destroy .sc
 165     update
 166 } {}
 167
 168 incr c
 169
 170 test Scrolledcanvas-1.$c {Scrolledcanvas construction} {
 171     iwidgets::Scrolledcanvas .sc -autoresize no -labelpos nw \
 172         -vscrollmode static -hscrollmode dynamic -labeltext "Scrolledcanvas"
 173     pack .sc -padx 10 -pady 10 -fill both -expand yes
 174     update
 175 } {}
 176
 177 incr c
 178
 179 test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
 180     destroy .sc
 181     update
 182 } {}
 183
 184 incr c
 185
 186 test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
 187     iwidgets::scrolledcanvas .sc
 188     pack .sc
 189     destroy .sc
 190     update
 191 } {}
 192
 193 ::tcltest::cleanupTests
 194 exit