#
|
#
|
# Tests for the "ensemble" compound command facility
|
# Tests for the "ensemble" compound command facility
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# AUTHOR: Michael J. McLennan
|
# AUTHOR: Michael J. McLennan
|
# Bell Labs Innovations for Lucent Technologies
|
# Bell Labs Innovations for Lucent Technologies
|
# mmclennan@lucent.com
|
# mmclennan@lucent.com
|
# http://www.tcltk.com/itcl
|
# http://www.tcltk.com/itcl
|
#
|
#
|
# RCS: $Id: ensemble.test,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
|
# RCS: $Id: ensemble.test,v 1.1.1.1 2002-01-16 10:24:47 markom Exp $
|
# ----------------------------------------------------------------------
|
# ----------------------------------------------------------------------
|
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
# Copyright (c) 1993-1998 Lucent Technologies, Inc.
|
# ======================================================================
|
# ======================================================================
|
# See the file "license.terms" for information on usage and
|
# See the file "license.terms" for information on usage and
|
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
|
|
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
if {[string compare test [info procs test]] == 1} then {source defs}
|
|
|
test ensemble-1.1 {ensemble name must be specified} {
|
test ensemble-1.1 {ensemble name must be specified} {
|
list [catch {ensemble} msg] $msg
|
list [catch {ensemble} msg] $msg
|
} {1 {wrong # args: should be "ensemble name ?command arg arg...?"}}
|
} {1 {wrong # args: should be "ensemble name ?command arg arg...?"}}
|
|
|
test ensemble-1.2 {creating a new ensemble} {
|
test ensemble-1.2 {creating a new ensemble} {
|
ensemble test_numbers {
|
ensemble test_numbers {
|
part one {x} {
|
part one {x} {
|
return "one: $x"
|
return "one: $x"
|
}
|
}
|
part two {x y} {
|
part two {x y} {
|
return "two: $x $y"
|
return "two: $x $y"
|
}
|
}
|
}
|
}
|
} ""
|
} ""
|
test ensemble-1.3 {adding to an existing ensemble} {
|
test ensemble-1.3 {adding to an existing ensemble} {
|
ensemble test_numbers part three {x y z} {
|
ensemble test_numbers part three {x y z} {
|
return "three: $x $y $z"
|
return "three: $x $y $z"
|
}
|
}
|
} ""
|
} ""
|
|
|
test ensemble-1.4 {invoking ensemble parts} {
|
test ensemble-1.4 {invoking ensemble parts} {
|
list [test_numbers one 1] [test_numbers two 2 3] [test_numbers three 3 4 5]
|
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}}
|
} {{one: 1} {two: 2 3} {three: 3 4 5}}
|
|
|
test ensemble-1.5 {invoking parts with improper arguments} {
|
test ensemble-1.5 {invoking parts with improper arguments} {
|
list [catch "test_numbers three x" msg] $msg
|
list [catch "test_numbers three x" msg] $msg
|
} {1 {no value given for parameter "y" to "test_numbers three"}}
|
} {1 {no value given for parameter "y" to "test_numbers three"}}
|
|
|
test ensemble-1.6 {errors trigger a usage summary} {
|
test ensemble-1.6 {errors trigger a usage summary} {
|
list [catch "test_numbers foo x y" msg] $msg
|
list [catch "test_numbers foo x y" msg] $msg
|
} {1 {bad option "foo": should be one of...
|
} {1 {bad option "foo": should be one of...
|
test_numbers one x
|
test_numbers one x
|
test_numbers three x y z
|
test_numbers three x y z
|
test_numbers two x y}}
|
test_numbers two x y}}
|
|
|
test ensemble-1.7 {one part can't overwrite another} {
|
test ensemble-1.7 {one part can't overwrite another} {
|
set cmd {
|
set cmd {
|
ensemble test_numbers part three {} {
|
ensemble test_numbers part three {} {
|
return "three: new version"
|
return "three: new version"
|
}
|
}
|
}
|
}
|
list [catch $cmd msg] $msg
|
list [catch $cmd msg] $msg
|
} {1 {part "three" already exists in ensemble}}
|
} {1 {part "three" already exists in ensemble}}
|
|
|
test ensemble-1.8 {an ensemble can't overwrite another part} {
|
test ensemble-1.8 {an ensemble can't overwrite another part} {
|
set cmd {
|
set cmd {
|
ensemble test_numbers ensemble three part new {} {
|
ensemble test_numbers ensemble three part new {} {
|
return "three: new version"
|
return "three: new version"
|
}
|
}
|
}
|
}
|
list [catch $cmd msg] $msg
|
list [catch $cmd msg] $msg
|
} {1 {part "three" is not an ensemble}}
|
} {1 {part "three" is not an ensemble}}
|
|
|
test ensemble-1.9 {body errors are handled gracefully} {
|
test ensemble-1.9 {body errors are handled gracefully} {
|
list [catch "ensemble test_numbers {foo bar baz}" msg] $msg $errorInfo
|
list [catch "ensemble test_numbers {foo bar baz}" msg] $msg $errorInfo
|
} {1 {invalid command name "foo"} {invalid command name "foo"
|
} {1 {invalid command name "foo"} {invalid command name "foo"
|
while executing
|
while executing
|
"foo bar baz"
|
"foo bar baz"
|
("ensemble" body line 1)
|
("ensemble" body line 1)
|
invoked from within
|
invoked from within
|
"ensemble test_numbers {foo bar baz}"}}
|
"ensemble test_numbers {foo bar baz}"}}
|
|
|
test ensemble-1.10 {part errors are handled gracefully} {
|
test ensemble-1.10 {part errors are handled gracefully} {
|
list [catch "ensemble test_numbers {part foo}" msg] $msg $errorInfo
|
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"
|
} {1 {wrong # args: should be "part name args body"} {wrong # args: should be "part name args body"
|
while executing
|
while executing
|
"part foo"
|
"part foo"
|
("ensemble" body line 1)
|
("ensemble" body line 1)
|
invoked from within
|
invoked from within
|
"ensemble test_numbers {part foo}"}}
|
"ensemble test_numbers {part foo}"}}
|
|
|
test ensemble-1.11 {part argument errors are handled gracefully} {
|
test ensemble-1.11 {part argument errors are handled gracefully} {
|
list [catch "ensemble test_numbers {part foo {{}} {}}" msg] $msg $errorInfo
|
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
|
} {1 {procedure "foo" has argument with no name} {procedure "foo" has argument with no name
|
while executing
|
while executing
|
"part foo {{}} {}"
|
"part foo {{}} {}"
|
("ensemble" body line 1)
|
("ensemble" body line 1)
|
invoked from within
|
invoked from within
|
"ensemble test_numbers {part foo {{}} {}}"}}
|
"ensemble test_numbers {part foo {{}} {}}"}}
|
|
|
test ensemble-2.0 {defining subensembles} {
|
test ensemble-2.0 {defining subensembles} {
|
ensemble test_numbers {
|
ensemble test_numbers {
|
ensemble hex {
|
ensemble hex {
|
part base {} {
|
part base {} {
|
return 16
|
return 16
|
}
|
}
|
part digits {args} {
|
part digits {args} {
|
foreach num $args {
|
foreach num $args {
|
lappend result "0x$num"
|
lappend result "0x$num"
|
}
|
}
|
return $result
|
return $result
|
}
|
}
|
}
|
}
|
ensemble octal {
|
ensemble octal {
|
part base {} {
|
part base {} {
|
return 8
|
return 8
|
}
|
}
|
part digits {{prefix 0} args} {
|
part digits {{prefix 0} args} {
|
foreach num $args {
|
foreach num $args {
|
lappend result "$prefix$num"
|
lappend result "$prefix$num"
|
}
|
}
|
return $result
|
return $result
|
}
|
}
|
}
|
}
|
}
|
}
|
list [catch "test_numbers foo" msg] $msg
|
list [catch "test_numbers foo" msg] $msg
|
} {1 {bad option "foo": should be one of...
|
} {1 {bad option "foo": should be one of...
|
test_numbers hex option ?arg arg ...?
|
test_numbers hex option ?arg arg ...?
|
test_numbers octal option ?arg arg ...?
|
test_numbers octal option ?arg arg ...?
|
test_numbers one x
|
test_numbers one x
|
test_numbers three x y z
|
test_numbers three x y z
|
test_numbers two x y}}
|
test_numbers two x y}}
|
|
|
test ensemble-2.1 {invoking sub-ensemble parts} {
|
test ensemble-2.1 {invoking sub-ensemble parts} {
|
list [catch "test_numbers hex base" msg] $msg
|
list [catch "test_numbers hex base" msg] $msg
|
} {0 16}
|
} {0 16}
|
|
|
test ensemble-2.2 {invoking sub-ensemble parts} {
|
test ensemble-2.2 {invoking sub-ensemble parts} {
|
list [catch "test_numbers hex digits 3 a f" msg] $msg
|
list [catch "test_numbers hex digits 3 a f" msg] $msg
|
} {0 {0x3 0xa 0xf}}
|
} {0 {0x3 0xa 0xf}}
|
|
|
test ensemble-2.3 {errors from sub-ensembles} {
|
test ensemble-2.3 {errors from sub-ensembles} {
|
list [catch "test_numbers hex" msg] $msg
|
list [catch "test_numbers hex" msg] $msg
|
} {1 {wrong # args: should be one of...
|
} {1 {wrong # args: should be one of...
|
test_numbers hex base
|
test_numbers hex base
|
test_numbers hex digits ?arg arg ...?}}
|
test_numbers hex digits ?arg arg ...?}}
|
|
|
test ensemble-2.4 {invoking sub-ensemble parts} {
|
test ensemble-2.4 {invoking sub-ensemble parts} {
|
list [catch "test_numbers octal base" msg] $msg
|
list [catch "test_numbers octal base" msg] $msg
|
} {0 8}
|
} {0 8}
|
|
|
test ensemble-2.5 {invoking sub-ensemble parts} {
|
test ensemble-2.5 {invoking sub-ensemble parts} {
|
list [catch "test_numbers octal digits 0o 3 5 10" msg] $msg
|
list [catch "test_numbers octal digits 0o 3 5 10" msg] $msg
|
} {0 {0o3 0o5 0o10}}
|
} {0 {0o3 0o5 0o10}}
|
|
|
test ensemble-2.6 {errors from sub-ensembles} {
|
test ensemble-2.6 {errors from sub-ensembles} {
|
list [catch "test_numbers octal" msg] $msg
|
list [catch "test_numbers octal" msg] $msg
|
} {1 {wrong # args: should be one of...
|
} {1 {wrong # args: should be one of...
|
test_numbers octal base
|
test_numbers octal base
|
test_numbers octal digits ?prefix? ?arg arg ...?}}
|
test_numbers octal digits ?prefix? ?arg arg ...?}}
|
|
|
test ensemble-2.7 {sub-ensembles can't be accidentally redefined} {
|
test ensemble-2.7 {sub-ensembles can't be accidentally redefined} {
|
set cmd {
|
set cmd {
|
ensemble test_numbers part octal {args} {
|
ensemble test_numbers part octal {args} {
|
return "octal: $args"
|
return "octal: $args"
|
}
|
}
|
}
|
}
|
list [catch $cmd msg] $msg
|
list [catch $cmd msg] $msg
|
} {1 {part "octal" already exists in ensemble}}
|
} {1 {part "octal" already exists in ensemble}}
|
|
|
test ensemble-3.0 {an error handler part can be used to handle errors} {
|
test ensemble-3.0 {an error handler part can be used to handle errors} {
|
ensemble test_numbers {
|
ensemble test_numbers {
|
part @error {args} {
|
part @error {args} {
|
return "error: $args"
|
return "error: $args"
|
}
|
}
|
}
|
}
|
list [catch {test_numbers foo 1 2 3} msg] $msg
|
list [catch {test_numbers foo 1 2 3} msg] $msg
|
} {0 {error: foo 1 2 3}}
|
} {0 {error: foo 1 2 3}}
|
|
|
test ensemble-3.1 {the error handler part shows up as generic "...and"} {
|
test ensemble-3.1 {the error handler part shows up as generic "...and"} {
|
list [catch {test_numbers} msg] $msg
|
list [catch {test_numbers} msg] $msg
|
} {1 {wrong # args: should be one of...
|
} {1 {wrong # args: should be one of...
|
test_numbers hex option ?arg arg ...?
|
test_numbers hex option ?arg arg ...?
|
test_numbers octal option ?arg arg ...?
|
test_numbers octal option ?arg arg ...?
|
test_numbers one x
|
test_numbers one x
|
test_numbers three x y z
|
test_numbers three x y z
|
test_numbers two x y
|
test_numbers two x y
|
...and others described on the man page}}
|
...and others described on the man page}}
|
|
|
