1# This file is a Tcl script to test out [incr Widgets] feedback 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: feedback.test
15
16package require tcltest
17namespace import -force ::tcltest::*
18
19if [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
31if {[string compare test [info procs test]] == 1} {
32    source defs
33}
34
35wm geometry . {}
36raise .
37
38set c 1
39set o 1
40set m 1
41
42#
43# Initial construction test
44#
45test Feedback-1.$c {Feedback construction} {
46    iwidgets::Feedback .f
47    pack .f -padx 10 -pady 10 -fill both -expand yes
48    update 
49} {}
50
51incr c
52
53#
54# Option tests which are successful.
55#
56test Feedback-2.$o {configuration option} {
57    llength [.f configure]
58} {22}
59
60incr o
61
62foreach test {
63    {-background #d9d9d9 #d9d9d9} 
64    {-cursor gumby gumby} 
65    {-foreground Black Black} 
66    {-labelmargin 5 5} 
67    {-labeltext Label Label}
68    {-labelpos n n} 
69    {-labelpos ne ne} 
70    {-labelpos e e} 
71    {-labelpos se se} 
72    {-labelpos s s} 
73    {-labelpos sw sw} 
74    {-labelpos w w} 
75    {-labelpos nw nw} 
76    {-barcolor red red}
77    {-steps 50 50}
78    {-sticky w w}
79    {-sticky nw nw}
80    {-sticky n n}
81    {-sticky ne ne}
82    {-sticky e e}
83    {-sticky se se}
84    {-sticky s s}
85    {-sticky sw sw}
86    {-sticky news news}
87    {-barheight 20 20}} {
88	set option [lindex $test 0]
89	test Feedback-2.$o "configuration options, $option" {
90	    .f configure $option [lindex $test 1]
91	    lindex [.f configure $option] 4
92	} [lindex $test 2]
93	update 
94	incr o
95}
96
97#
98# Option tests which fail and produce errors.
99#
100#foreach test {
101#  {} {
102#	set option [lindex $test 0]
103#        test Feedback-2.$o "configuration options, $option" {
104#	    list [catch {.f configure $option [lindex $test 1]} msg] $msg
105#	} [list 1 [lindex $test 2]]
106#	incr o
107#}
108
109#
110# Method tests which are successful.
111#
112foreach test {
113    {{.f step} {}}} {
114	set method [lindex [lindex $test 0] 1]
115	test Feedback-3.$m "object methods, $method" {
116	    list [catch {eval [lindex $test 0]} msg] $msg
117	} [list 0 [lindex $test 1]]
118	update 
119	incr m
120}
121
122#
123# Conclusion of construction/destruction tests
124#
125test Feedback-1.$c {Feedback destruction} {
126    destroy .f
127    update 
128} {}
129
130incr c
131
132test Feedback-1.$c {Feedback construction} {
133    iwidgets::feedback .f -labeltext "Label" \
134	    -labelpos n -labelmargin 5
135    pack .f -padx 10 -pady 10 -fill both -expand yes
136    update 
137} {}
138
139incr c
140
141test Feedback-1.$c {Feedback destruction} {
142    destroy .f
143    update 
144} {}
145
146incr c
147
148test Feedback-1.$c {Feedback destruction} {
149    iwidgets::feedback .f
150    pack .f
151    destroy .f
152    update 
153} {}
154
155
156::tcltest::cleanupTests
157exit
158