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