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