1# This file is a Tcl script to test out all of the "usual" options 2# for all of the [incr Widgets]. It looks for other tests in this 3# directory, and tries to create a mega-widget with each of these 4# as a component. If there are any problems with "usual" definitions, 5# they will be found here. 6# 7# See the file "license.terms" for information on usage and redistribution 8# of this file, and for a DISCLAIMER OF ALL WARRANTIES. 9# 10# @(#) $Id: usual.test,v 1.3 2001/08/07 19:56:48 smithc Exp $ 11 12package require tcltest 13namespace import -force ::tcltest::* 14 15if [catch {package require Iwidgets 4.0}] { 16 # Let's try modifying the auto_path. Note that the IWIDGETS_LIBRARY 17 # env var is initialized in the Makefile when doing a 'make test'. 18 # If sourcing this file independently, this variable must be set manually. 19 if ![info exists env(IWIDGETS_LIBRARY)] { 20 error "Unable to locate Iwidgets package. Set your IWIDGETS_LIBRARY\ 21 environment\nvariable to the directory that contains iwidgets.tcl" 22 } 23 lappend auto_path $env(IWIDGETS_LIBRARY) 24 package require Iwidgets 4.0 25} 26 27if {[string compare test [info procs test]] == 1} { 28 source defs 29} 30 31wm geometry . {} 32raise . 33 34# ---------------------------------------------------------------------- 35# Create a new mega-widget class that we can use to add other 36# classes as components. 37# ---------------------------------------------------------------------- 38test usual-1.1 {create a mega-widget that we can add components to} { 39 itcl::class TestUsual { 40 inherit itk::Widget 41 method do {cmd} { 42 eval $cmd 43 } 44 } 45 TestUsual .testUsual 46} {.testUsual} 47 48# ---------------------------------------------------------------------- 49# Now, scan through all of the tests in this directory and look 50# for mega-widgets. Add each mega-widget to the test class. 51# ---------------------------------------------------------------------- 52set unique 0 53foreach file [glob *.test] { 54 set widget [file rootname [file tail $file]] 55 if {$widget == "extbutton"} { 56 if {$::tk_version < 8.4} { 57 # Skip it. 58 continue 59 } 60 } 61 62 if {$widget != "usual"} { 63 set name "c[incr unique]" 64 test usual-1.2.$name "verify \"usual\" options for $widget" { 65 .testUsual do [format { 66 itk_component add %s { 67 iwidgets::%s $itk_interior.%s 68 } 69 } $name $widget $name] 70 } $name 71 } 72} 73 74::tcltest::cleanupTests 75exit 76