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