1 |
578 |
markom |
#
|
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.1.1.1 2002-01-16 10:24:47 markom 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 |
|
|
|
16 |
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
17 |
|
|
|
18 |
|
|
test ensemble-1.1 {ensemble name must be specified} {
|
19 |
|
|
list [catch {ensemble} msg] $msg
|
20 |
|
|
} {1 {wrong # args: should be "ensemble name ?command arg arg...?"}}
|
21 |
|
|
|
22 |
|
|
test ensemble-1.2 {creating a new ensemble} {
|
23 |
|
|
ensemble test_numbers {
|
24 |
|
|
part one {x} {
|
25 |
|
|
return "one: $x"
|
26 |
|
|
}
|
27 |
|
|
part two {x y} {
|
28 |
|
|
return "two: $x $y"
|
29 |
|
|
}
|
30 |
|
|
}
|
31 |
|
|
} ""
|
32 |
|
|
test ensemble-1.3 {adding to an existing ensemble} {
|
33 |
|
|
ensemble test_numbers part three {x y z} {
|
34 |
|
|
return "three: $x $y $z"
|
35 |
|
|
}
|
36 |
|
|
} ""
|
37 |
|
|
|
38 |
|
|
test ensemble-1.4 {invoking ensemble parts} {
|
39 |
|
|
list [test_numbers one 1] [test_numbers two 2 3] [test_numbers three 3 4 5]
|
40 |
|
|
} {{one: 1} {two: 2 3} {three: 3 4 5}}
|
41 |
|
|
|
42 |
|
|
test ensemble-1.5 {invoking parts with improper arguments} {
|
43 |
|
|
list [catch "test_numbers three x" msg] $msg
|
44 |
|
|
} {1 {no value given for parameter "y" to "test_numbers three"}}
|
45 |
|
|
|
46 |
|
|
test ensemble-1.6 {errors trigger a usage summary} {
|
47 |
|
|
list [catch "test_numbers foo x y" msg] $msg
|
48 |
|
|
} {1 {bad option "foo": should be one of...
|
49 |
|
|
test_numbers one x
|
50 |
|
|
test_numbers three x y z
|
51 |
|
|
test_numbers two x y}}
|
52 |
|
|
|
53 |
|
|
test ensemble-1.7 {one part can't overwrite another} {
|
54 |
|
|
set cmd {
|
55 |
|
|
ensemble test_numbers part three {} {
|
56 |
|
|
return "three: new version"
|
57 |
|
|
}
|
58 |
|
|
}
|
59 |
|
|
list [catch $cmd msg] $msg
|
60 |
|
|
} {1 {part "three" already exists in ensemble}}
|
61 |
|
|
|
62 |
|
|
test ensemble-1.8 {an ensemble can't overwrite another part} {
|
63 |
|
|
set cmd {
|
64 |
|
|
ensemble test_numbers ensemble three part new {} {
|
65 |
|
|
return "three: new version"
|
66 |
|
|
}
|
67 |
|
|
}
|
68 |
|
|
list [catch $cmd msg] $msg
|
69 |
|
|
} {1 {part "three" is not an ensemble}}
|
70 |
|
|
|
71 |
|
|
test ensemble-1.9 {body errors are handled gracefully} {
|
72 |
|
|
list [catch "ensemble test_numbers {foo bar baz}" msg] $msg $errorInfo
|
73 |
|
|
} {1 {invalid command name "foo"} {invalid command name "foo"
|
74 |
|
|
while executing
|
75 |
|
|
"foo bar baz"
|
76 |
|
|
("ensemble" body line 1)
|
77 |
|
|
invoked from within
|
78 |
|
|
"ensemble test_numbers {foo bar baz}"}}
|
79 |
|
|
|
80 |
|
|
test ensemble-1.10 {part errors are handled gracefully} {
|
81 |
|
|
list [catch "ensemble test_numbers {part foo}" msg] $msg $errorInfo
|
82 |
|
|
} {1 {wrong # args: should be "part name args body"} {wrong # args: should be "part name args body"
|
83 |
|
|
while executing
|
84 |
|
|
"part foo"
|
85 |
|
|
("ensemble" body line 1)
|
86 |
|
|
invoked from within
|
87 |
|
|
"ensemble test_numbers {part foo}"}}
|
88 |
|
|
|
89 |
|
|
test ensemble-1.11 {part argument errors are handled gracefully} {
|
90 |
|
|
list [catch "ensemble test_numbers {part foo {{}} {}}" msg] $msg $errorInfo
|
91 |
|
|
} {1 {procedure "foo" has argument with no name} {procedure "foo" has argument with no name
|
92 |
|
|
while executing
|
93 |
|
|
"part foo {{}} {}"
|
94 |
|
|
("ensemble" body line 1)
|
95 |
|
|
invoked from within
|
96 |
|
|
"ensemble test_numbers {part foo {{}} {}}"}}
|
97 |
|
|
|
98 |
|
|
test ensemble-2.0 {defining subensembles} {
|
99 |
|
|
ensemble test_numbers {
|
100 |
|
|
ensemble hex {
|
101 |
|
|
part base {} {
|
102 |
|
|
return 16
|
103 |
|
|
}
|
104 |
|
|
part digits {args} {
|
105 |
|
|
foreach num $args {
|
106 |
|
|
lappend result "0x$num"
|
107 |
|
|
}
|
108 |
|
|
return $result
|
109 |
|
|
}
|
110 |
|
|
}
|
111 |
|
|
ensemble octal {
|
112 |
|
|
part base {} {
|
113 |
|
|
return 8
|
114 |
|
|
}
|
115 |
|
|
part digits {{prefix 0} args} {
|
116 |
|
|
foreach num $args {
|
117 |
|
|
lappend result "$prefix$num"
|
118 |
|
|
}
|
119 |
|
|
return $result
|
120 |
|
|
}
|
121 |
|
|
}
|
122 |
|
|
}
|
123 |
|
|
list [catch "test_numbers foo" msg] $msg
|
124 |
|
|
} {1 {bad option "foo": should be one of...
|
125 |
|
|
test_numbers hex option ?arg arg ...?
|
126 |
|
|
test_numbers octal option ?arg arg ...?
|
127 |
|
|
test_numbers one x
|
128 |
|
|
test_numbers three x y z
|
129 |
|
|
test_numbers two x y}}
|
130 |
|
|
|
131 |
|
|
test ensemble-2.1 {invoking sub-ensemble parts} {
|
132 |
|
|
list [catch "test_numbers hex base" msg] $msg
|
133 |
|
|
} {0 16}
|
134 |
|
|
|
135 |
|
|
test ensemble-2.2 {invoking sub-ensemble parts} {
|
136 |
|
|
list [catch "test_numbers hex digits 3 a f" msg] $msg
|
137 |
|
|
} {0 {0x3 0xa 0xf}}
|
138 |
|
|
|
139 |
|
|
test ensemble-2.3 {errors from sub-ensembles} {
|
140 |
|
|
list [catch "test_numbers hex" msg] $msg
|
141 |
|
|
} {1 {wrong # args: should be one of...
|
142 |
|
|
test_numbers hex base
|
143 |
|
|
test_numbers hex digits ?arg arg ...?}}
|
144 |
|
|
|
145 |
|
|
test ensemble-2.4 {invoking sub-ensemble parts} {
|
146 |
|
|
list [catch "test_numbers octal base" msg] $msg
|
147 |
|
|
} {0 8}
|
148 |
|
|
|
149 |
|
|
test ensemble-2.5 {invoking sub-ensemble parts} {
|
150 |
|
|
list [catch "test_numbers octal digits 0o 3 5 10" msg] $msg
|
151 |
|
|
} {0 {0o3 0o5 0o10}}
|
152 |
|
|
|
153 |
|
|
test ensemble-2.6 {errors from sub-ensembles} {
|
154 |
|
|
list [catch "test_numbers octal" msg] $msg
|
155 |
|
|
} {1 {wrong # args: should be one of...
|
156 |
|
|
test_numbers octal base
|
157 |
|
|
test_numbers octal digits ?prefix? ?arg arg ...?}}
|
158 |
|
|
|
159 |
|
|
test ensemble-2.7 {sub-ensembles can't be accidentally redefined} {
|
160 |
|
|
set cmd {
|
161 |
|
|
ensemble test_numbers part octal {args} {
|
162 |
|
|
return "octal: $args"
|
163 |
|
|
}
|
164 |
|
|
}
|
165 |
|
|
list [catch $cmd msg] $msg
|
166 |
|
|
} {1 {part "octal" already exists in ensemble}}
|
167 |
|
|
|
168 |
|
|
test ensemble-3.0 {an error handler part can be used to handle errors} {
|
169 |
|
|
ensemble test_numbers {
|
170 |
|
|
part @error {args} {
|
171 |
|
|
return "error: $args"
|
172 |
|
|
}
|
173 |
|
|
}
|
174 |
|
|
list [catch {test_numbers foo 1 2 3} msg] $msg
|
175 |
|
|
} {0 {error: foo 1 2 3}}
|
176 |
|
|
|
177 |
|
|
test ensemble-3.1 {the error handler part shows up as generic "...and"} {
|
178 |
|
|
list [catch {test_numbers} msg] $msg
|
179 |
|
|
} {1 {wrong # args: should be one of...
|
180 |
|
|
test_numbers hex option ?arg arg ...?
|
181 |
|
|
test_numbers octal option ?arg arg ...?
|
182 |
|
|
test_numbers one x
|
183 |
|
|
test_numbers three x y z
|
184 |
|
|
test_numbers two x y
|
185 |
|
|
...and others described on the man page}}
|