1# 2# Tests for the "ensemble" compound command facility 3# ---------------------------------------------------------------------- 4# AUTHOR: Michael J. McLennan 5# Bell Labs Innovations for Lucent Technologies 6# mmclennan@lucent.com 7# http://www.tcltk.com/itcl 8# 9# RCS: $Id: ensemble.test,v 1.5 2004/02/12 18:09:50 davygrvy Exp $ 10# ---------------------------------------------------------------------- 11# Copyright (c) 1993-1998 Lucent Technologies, Inc. 12# ====================================================================== 13# See the file "license.terms" for information on usage and 14# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. 15 16if {[lsearch [namespace children] ::tcltest] == -1} { 17 package require tcltest 2.1 18 namespace import -force ::tcltest::test 19} 20 21::tcltest::loadTestedCommands 22 23test ensemble-1.1 {ensemble name must be specified} { 24 list [catch {itcl::ensemble} msg] $msg 25} {1 {wrong # args: should be "itcl::ensemble name ?command arg arg...?"}} 26 27test ensemble-1.2 {creating a new ensemble} { 28 itcl::ensemble test_numbers { 29 part one {x} { 30 return "one: $x" 31 } 32 part two {x y} { 33 return "two: $x $y" 34 } 35 } 36} "" 37test ensemble-1.3 {adding to an existing ensemble} { 38 itcl::ensemble test_numbers part three {x y z} { 39 return "three: $x $y $z" 40 } 41} "" 42 43test ensemble-1.4 {invoking ensemble parts} { 44 list [test_numbers one 1] [test_numbers two 2 3] [test_numbers three 3 4 5] 45} {{one: 1} {two: 2 3} {three: 3 4 5}} 46 47test ensemble-1.5 {invoking parts with improper arguments} { 48 set res [catch "test_numbers three x" msg] 49 if {[package vsatisfies [package provide Tcl] 8.4]} { 50 lappend res [string match "wrong # args*" $msg] 51 } else { 52 lappend res [string match "no value given*" $msg] 53 } 54} {1 1} 55 56test ensemble-1.6 {errors trigger a usage summary} { 57 list [catch "test_numbers foo x y" msg] $msg 58} {1 {bad option "foo": should be one of... 59 test_numbers one x 60 test_numbers three x y z 61 test_numbers two x y}} 62 63test ensemble-1.7 {one part can't overwrite another} { 64 set cmd { 65 itcl::ensemble test_numbers part three {} { 66 return "three: new version" 67 } 68 } 69 list [catch $cmd msg] $msg 70} {1 {part "three" already exists in ensemble}} 71 72test ensemble-1.8 {an ensemble can't overwrite another part} { 73 set cmd { 74 itcl::ensemble test_numbers ensemble three part new {} { 75 return "three: new version" 76 } 77 } 78 list [catch $cmd msg] $msg 79} {1 {part "three" is not an ensemble}} 80 81test ensemble-1.9 {body errors are handled gracefully} { 82 list [catch "itcl::ensemble test_numbers {foo bar baz}" msg] $msg $errorInfo 83} {1 {invalid command name "foo"} {invalid command name "foo" 84 while executing 85"foo bar baz" 86 ("ensemble" body line 1) 87 invoked from within 88"itcl::ensemble test_numbers {foo bar baz}"}} 89 90test ensemble-1.10 {part errors are handled gracefully} { 91 list [catch "itcl::ensemble test_numbers {part foo}" msg] $msg $errorInfo 92} {1 {wrong # args: should be "part name args body"} {wrong # args: should be "part name args body" 93 while executing 94"part foo" 95 ("ensemble" body line 1) 96 invoked from within 97"itcl::ensemble test_numbers {part foo}"}} 98 99test ensemble-1.11 {part argument errors are handled gracefully} { 100 list [catch "itcl::ensemble test_numbers {part foo {{}} {}}" msg] $msg $errorInfo 101} {1 {procedure "foo" has argument with no name} {procedure "foo" has argument with no name 102 while executing 103"part foo {{}} {}" 104 ("ensemble" body line 1) 105 invoked from within 106"itcl::ensemble test_numbers {part foo {{}} {}}"}} 107 108test ensemble-2.0 {defining subensembles} { 109 itcl::ensemble test_numbers { 110 ensemble hex { 111 part base {} { 112 return 16 113 } 114 part digits {args} { 115 foreach num $args { 116 lappend result "0x$num" 117 } 118 return $result 119 } 120 } 121 ensemble octal { 122 part base {} { 123 return 8 124 } 125 part digits {{prefix 0} args} { 126 foreach num $args { 127 lappend result "$prefix$num" 128 } 129 return $result 130 } 131 } 132 } 133 list [catch "test_numbers foo" msg] $msg 134} {1 {bad option "foo": should be one of... 135 test_numbers hex option ?arg arg ...? 136 test_numbers octal option ?arg arg ...? 137 test_numbers one x 138 test_numbers three x y z 139 test_numbers two x y}} 140 141test ensemble-2.1 {invoking sub-ensemble parts} { 142 list [catch "test_numbers hex base" msg] $msg 143} {0 16} 144 145test ensemble-2.2 {invoking sub-ensemble parts} { 146 list [catch "test_numbers hex digits 3 a f" msg] $msg 147} {0 {0x3 0xa 0xf}} 148 149test ensemble-2.3 {errors from sub-ensembles} { 150 list [catch "test_numbers hex" msg] $msg 151} {1 {wrong # args: should be one of... 152 test_numbers hex base 153 test_numbers hex digits ?arg arg ...?}} 154 155test ensemble-2.4 {invoking sub-ensemble parts} { 156 list [catch "test_numbers octal base" msg] $msg 157} {0 8} 158 159test ensemble-2.5 {invoking sub-ensemble parts} { 160 list [catch "test_numbers octal digits 0o 3 5 10" msg] $msg 161} {0 {0o3 0o5 0o10}} 162 163test ensemble-2.6 {errors from sub-ensembles} { 164 list [catch "test_numbers octal" msg] $msg 165} {1 {wrong # args: should be one of... 166 test_numbers octal base 167 test_numbers octal digits ?prefix? ?arg arg ...?}} 168 169test ensemble-2.7 {sub-ensembles can't be accidentally redefined} { 170 set cmd { 171 itcl::ensemble test_numbers part octal {args} { 172 return "octal: $args" 173 } 174 } 175 list [catch $cmd msg] $msg 176} {1 {part "octal" already exists in ensemble}} 177 178test ensemble-3.0 {an error handler part can be used to handle errors} { 179 itcl::ensemble test_numbers { 180 part @error {args} { 181 return "error: $args" 182 } 183 } 184 list [catch {test_numbers foo 1 2 3} msg] $msg 185} {0 {error: foo 1 2 3}} 186 187test ensemble-3.1 {the error handler part shows up as generic "...and"} { 188 list [catch {test_numbers} msg] $msg 189} {1 {wrong # args: should be one of... 190 test_numbers hex option ?arg arg ...? 191 test_numbers octal option ?arg arg ...? 192 test_numbers one x 193 test_numbers three x y z 194 test_numbers two x y 195...and others described on the man page}} 196 197::tcltest::cleanupTests 198return 199