1 |
578 |
markom |
#
|
2 |
|
|
# Tests for argument lists and method execution
|
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: methods.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 |
|
|
# ----------------------------------------------------------------------
|
19 |
|
|
# Methods with various argument lists
|
20 |
|
|
# ----------------------------------------------------------------------
|
21 |
|
|
test methods-1.1 {define a class with lots of methods and arg lists} {
|
22 |
|
|
itcl::class test_args {
|
23 |
|
|
method none {} {
|
24 |
|
|
return "none"
|
25 |
|
|
}
|
26 |
|
|
method two {x y} {
|
27 |
|
|
return "two: $x $y"
|
28 |
|
|
}
|
29 |
|
|
method defvals {x {y def1} {z def2}} {
|
30 |
|
|
return "defvals: $x $y $z"
|
31 |
|
|
}
|
32 |
|
|
method varargs {x {y def1} args} {
|
33 |
|
|
return "varargs: $x $y ($args)"
|
34 |
|
|
}
|
35 |
|
|
method nomagic {args x} {
|
36 |
|
|
return "nomagic: $args $x"
|
37 |
|
|
}
|
38 |
|
|
method clash {x bang boom} {
|
39 |
|
|
return "clash: $x $bang $boom"
|
40 |
|
|
}
|
41 |
|
|
proc crash {x bang boom} {
|
42 |
|
|
return "crash: $x $bang $boom"
|
43 |
|
|
}
|
44 |
|
|
variable bang "ok"
|
45 |
|
|
common boom "no-problem"
|
46 |
|
|
}
|
47 |
|
|
} ""
|
48 |
|
|
|
49 |
|
|
test methods-1.2 {create an object to execute tests} {
|
50 |
|
|
test_args ta
|
51 |
|
|
} {ta}
|
52 |
|
|
|
53 |
|
|
test methods-1.3 {argument checking: not enough args} {
|
54 |
|
|
list [catch {ta two 1} msg] $msg
|
55 |
|
|
} {1 {wrong # args: should be "ta two x y"}}
|
56 |
|
|
|
57 |
|
|
test methods-1.4a {argument checking: too many args} {
|
58 |
|
|
list [catch {ta two 1 2 3} msg] $msg
|
59 |
|
|
} {1 {wrong # args: should be "ta two x y"}}
|
60 |
|
|
|
61 |
|
|
test methods-1.4b {argument checking: too many args} {
|
62 |
|
|
list [catch {ta none 1 2 3} msg] $msg
|
63 |
|
|
} {1 {wrong # args: should be "ta none"}}
|
64 |
|
|
|
65 |
|
|
test methods-1.5a {argument checking: just right} {
|
66 |
|
|
list [catch {ta two 1 2} msg] $msg
|
67 |
|
|
} {0 {two: 1 2}}
|
68 |
|
|
|
69 |
|
|
test methods-1.5b {argument checking: just right} {
|
70 |
|
|
list [catch {ta none} msg] $msg
|
71 |
|
|
} {0 none}
|
72 |
|
|
|
73 |
|
|
test methods-1.6a {default arguments: not enough args} {
|
74 |
|
|
list [catch {ta defvals} msg] $msg
|
75 |
|
|
} {1 {wrong # args: should be "ta defvals x ?y? ?z?"}}
|
76 |
|
|
|
77 |
|
|
test methods-1.6b {default arguments: missing arguments supplied} {
|
78 |
|
|
list [catch {ta defvals 1} msg] $msg
|
79 |
|
|
} {0 {defvals: 1 def1 def2}}
|
80 |
|
|
|
81 |
|
|
test methods-1.6c {default arguments: missing arguments supplied} {
|
82 |
|
|
list [catch {ta defvals 1 2} msg] $msg
|
83 |
|
|
} {0 {defvals: 1 2 def2}}
|
84 |
|
|
|
85 |
|
|
test methods-1.6d {default arguments: all arguments assigned} {
|
86 |
|
|
list [catch {ta defvals 1 2 3} msg] $msg
|
87 |
|
|
} {0 {defvals: 1 2 3}}
|
88 |
|
|
|
89 |
|
|
test methods-1.6e {default arguments: too many args} {
|
90 |
|
|
list [catch {ta defvals 1 2 3 4} msg] $msg
|
91 |
|
|
} {1 {wrong # args: should be "ta defvals x ?y? ?z?"}}
|
92 |
|
|
|
93 |
|
|
test methods-1.7a {variable arguments: not enough args} {
|
94 |
|
|
list [catch {ta varargs} msg] $msg
|
95 |
|
|
} {1 {wrong # args: should be "ta varargs x ?y? ?arg arg ...?"}}
|
96 |
|
|
|
97 |
|
|
test methods-1.7b {variable arguments: empty} {
|
98 |
|
|
list [catch {ta varargs 1 2} msg] $msg
|
99 |
|
|
} {0 {varargs: 1 2 ()}}
|
100 |
|
|
|
101 |
|
|
test methods-1.7c {variable arguments: one} {
|
102 |
|
|
list [catch {ta varargs 1 2 one} msg] $msg
|
103 |
|
|
} {0 {varargs: 1 2 (one)}}
|
104 |
|
|
|
105 |
|
|
test methods-1.7d {variable arguments: two} {
|
106 |
|
|
list [catch {ta varargs 1 2 one two} msg] $msg
|
107 |
|
|
} {0 {varargs: 1 2 (one two)}}
|
108 |
|
|
|
109 |
|
|
test methods-1.8 {magic "args" argument has no magic unless at end of list} {
|
110 |
|
|
list [catch {ta nomagic 1 2 3 4} msg] $msg
|
111 |
|
|
} {1 {wrong # args: should be "ta nomagic args x"}}
|
112 |
|
|
|
113 |
|
|
test methods-1.9 {formal args don't clobber class members} {
|
114 |
|
|
list [catch {ta clash 1 2 3} msg] $msg \
|
115 |
|
|
[ta info variable bang -value] \
|
116 |
|
|
[ta info variable boom -value]
|
117 |
|
|
} {0 {clash: 1 2 3} ok no-problem}
|
118 |
|
|
|
119 |
|
|
test methods-1.10 {formal args don't clobber class members} {
|
120 |
|
|
list [catch {test_args::crash 4 5 6} msg] $msg \
|
121 |
|
|
[ta info variable bang -value] \
|
122 |
|
|
[ta info variable boom -value]
|
123 |
|
|
} {0 {crash: 4 5 6} ok no-problem}
|
124 |
|
|
|
125 |
|
|
# ----------------------------------------------------------------------
|
126 |
|
|
# Clean up
|
127 |
|
|
# ----------------------------------------------------------------------
|
128 |
|
|
delete class test_args
|