blob: 87037481cd91a0015575034c5e625295b1b63cbf (
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
|
source [file dirname [info script]]/testing.tcl
needs constraint jim
needs cmd array
proc aproc {} {
list
}
proc bproc {b} {
list b $b
}
proc cproc {b c} {
list b $b c $c
}
proc dproc {b c {d dd}} {
list b $b c $c d $d
}
proc eproc {b c {d dd} e} {
list b $b c $c d $d e $e
}
proc fproc {b c {d dd} args} {
list b $b c $c d $d args $args
}
proc gproc {b c {d dd} args e} {
list b $b c $c d $d args $args e $e
}
proc hproc {{a aa} args} {
list a $a args $args
}
proc iproc {{a aa} b {c cc}} {
list a $a b $b c $c
}
proc jproc {args {a aa} b {c cc} d} {
list a $a b $b c $c d $d args $args
}
set n 1
foreach {proc params result} {
aproc {} {}
bproc B {b B}
cproc {B C} {b B c C}
dproc {B C} {b B c C d dd}
dproc {B C D} {b B c C d D}
eproc {B C D E} {b B c C d D e E}
eproc {B C E} {b B c C d dd e E}
fproc {B C} {b B c C d dd args {}}
fproc {B C D} {b B c C d D args {}}
fproc {B C D E} {b B c C d D args E}
fproc {B C D E F} {b B c C d D args {E F}}
gproc {B C E} {b B c C d dd args {} e E}
gproc {B C D E} {b B c C d D args {} e E}
gproc {B C D X E} {b B c C d D args X e E}
gproc {B C D X Y Z E} {b B c C d D args {X Y Z} e E}
hproc {} {a aa args {}}
hproc {A} {a A args {}}
hproc {A X Y Z} {a A args {X Y Z}}
iproc {B} {a aa b B c cc}
iproc {A B} {a A b B c cc}
iproc {A B C} {a A b B c C}
jproc {B D} {a aa b B c cc d D args {}}
jproc {A B D} {a A b B c cc d D args {}}
jproc {A B C D} {a A b B c C d D args {}}
jproc {E F A B C D} {a A b B c C d D args {E F}}
} {
test proc-1.$n "Proc args combos" [list $proc {*}$params] $result
incr n
}
proc onearg_search {{nocase ""} value list} {
lsearch {*}$nocase $list $value
}
proc multiarg_search {args value list} {
lsearch {*}$args $list $value
}
test proc-2.1 "Real test of optional switches" {
onearg_search c {A a B b C c D d}
} 5
test proc-2.2 "Real test of optional switches" {
onearg_search -nocase c {A a B b C c D d}
} 4
test proc-2.3 "Real test of optional switches" {
multiarg_search -glob c* {A a B b C c D d}
} 5
test proc-2.4 "Real test of optional switches" {
multiarg_search -nocase -glob c* {A a B b C c D d}
} 4
test proc-3.1 "Rename optional args" {
proc a {b {args vars}} {
}
catch {a} msg
set msg
} {wrong # args: should be "a b ?vars ...?"}
test proc-3.2 "Rename optional args" {
proc a {b {args vars} c} {
}
catch {a} msg
set msg
} {wrong # args: should be "a b ?vars ...? c"}
test proc-3.2 "Rename optional args" {
proc a {b {args vars}} {
return $vars
}
a B C D
} {C D}
test proc-3.3 "dict sugar arg" {
proc a {b(c)} { return $b}
a 4
} {c 4}
test proc-3.4 "invalid upref in rightargs" {
proc a {{x 2} &b} { return $b}
unset -nocomplain B
catch {a B}
} 1
testreport
|
