blob: bcafe047c9b61a7b0443b7ddfdeeac5298228fb8 (
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
186
187
188
189
190
191
192
193
194
195
|
source [file dirname [info script]]/testing.tcl
needs constraint jim
needs cmd array
needs cmd ref
test alias-1.1 "One word alias" {
set x 2
alias newincr incr
newincr x
} {3}
test alias-1.4 "Two word alias" {
alias infoexists info exists
infoexists x
} {1}
test alias-1.5 "Replace alias" {
alias newincr infoexists
newincr x
} {1}
test alias-1.6 "Delete alias" {
rename newincr ""
catch {newincr x}
} {1}
test alias-1.7 "Replace alias with proc" {
proc infoexists {n} {
return yes
}
infoexists any
} {yes}
test alias-1.8 "Replace proc with alias" {
alias infoexists info exists
infoexists any
} {0}
test curry-1.1 "One word curry" {
set x 2
set one [curry incr]
$one x
} {3}
test curry-1.4 "Two word curry" {
set two [curry info exists]
list [$two x] [$two y]
} {1 0}
test curry-1.5 "Delete curry" {
unset one two
collect
} {2}
test local-1.1 "local lambda in eval" {
set x 1
eval {
local set a [lambda {b} { incr b }]
set x [$a $x]
}
list [info procs $a] $x
} {{} 2}
test local-1.2 "local curry in proc" {
proc a {} {
local set p [curry info exists]
set x 1
list $p [$p x] [$p y]
}
lassign [a] p exists_x exists_y
list [info procs $p] $exists_x $exists_y
} {{} 1 0}
test local-1.2 "set local curry in proc" {
proc a {} {
set p [local curry info exists]
set x 1
list $p [$p x] [$p y]
}
lassign [a] p exists_x exists_y
list [info procs $p] $exists_x $exists_y
} {{} 1 0}
test local-1.3 "local alias in proc" {
proc a {} {
local alias p info exists
set x 1
list [p x] [p y]
}
lassign [a] exists_x exists_y
list [info procs p] $exists_x $exists_y
} {{} 1 0}
test local-1.5 "local proc in proc" {
set ::x 1
proc a {} {
local proc b {} { incr ::x }
b
set ::x
}
a
list [info procs b] $::x
} {{} 2}
test local-1.6 "local lambda in lsort" {
lsort -command [local lambda {a b} {string compare $a $b}] {d a f g}
} {a d f g}
test local-1.7 "check no reference procs" {
info procs "<reference*"
} {}
test local-1.8 "local on non-proc" {
list [catch {local set x blah} msg] $msg
} {1 {not a proc: "blah"}}
test local-1.9 "local on existing proc" {
eval {
proc a {b} {incr b}
local function a
set c [lambda b {incr b -1}]
local function $c
lappend result [a 1] [$c 2]
}
list [info procs a] $result
} {{} {2 1}}
test statics-1.1 "missing static variable init" {
unset -nocomplain c
catch {
proc a {b} {c} {
# No initialiser for c
}
}
} 1
test statics-1.2 "static variable with invalid name" {
catch {
proc a {b} "{c\0d 4}" {
}
}
} 1
test statics-1.3 "duplicate static variable" {
catch {
proc a {b} {{c 1} {c 2}} {
}
}
} 1
test statics-1.4 "bad static variable init" {
catch {
proc a {b} {{c 1 2}} {
}
}
} 1
test local-2.1 "proc over existing proc" {
proc a {b} {incr b}
proc t {x} {
proc a {b} {incr b -1}
a $x
}
unset -nocomplain x
lappend x [a 5]
lappend x [t 5]
lappend x [a 5]
} {6 4 4}
test local-2.2 "local proc over existing proc" {
proc a {b} {incr b}
proc t {x} {
local proc a {b} {incr b -1}
a $x
}
unset -nocomplain x
lappend x [a 5]
lappend x [t 5]
lappend x [a 5]
} {6 4 6}
test local-2.3 "local proc over existing proc" {
proc a {b} {incr b}
proc t {x} {
local proc a {b} {incr b -1}
a $x
}
unset -nocomplain x
lappend x [a 5]
lappend x [t 5]
lappend x [a 5]
} {6 4 6}
testreport
|
