OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [set-old.test] - Blame information for rev 1765

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered:  set, unset, array
2 
#
3 
# This file includes the original set of tests for Tcl's set command.
4 
# Since the set command is now compiled, a new set of tests covering
5 
# the new implementation is in the file "set.test". Sourcing this file
6 
# into Tcl runs the tests and generates output for errors.
7 
# No output means no errors were found.
8 
#
9 
# Copyright (c) 1991-1993 The Regents of the University of California.
10 
# Copyright (c) 1994-1997 Sun Microsystems, Inc.
11 
#
12 
# See the file "license.terms" for information on usage and redistribution
13 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
14 
#
15 
# RCS: @(#) $Id: set-old.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
16 
 
17 
if {[string compare test [info procs test]] == 1} then {source defs}
18 
 
19 
proc ignore args {}
20 
 
21 
# Simple variable operations.
22 
 
23 
catch {unset a}
24 
test set-old-1.1 {basic variable setting and unsetting} {
25 
    set a 22
26 
} 22
27 
test set-old-1.2 {basic variable setting and unsetting} {
28 
    set a 123
29 
    set a
30 
} 123
31 
test set-old-1.3 {basic variable setting and unsetting} {
32 
    set a xxx
33 
    format %s $a
34 
} xxx
35 
test set-old-1.4 {basic variable setting and unsetting} {
36 
    set a 44
37 
    unset a
38 
    list [catch {set a} msg] $msg
39 
} {1 {can't read "a": no such variable}}
40 
 
41 
# Basic array operations.
42 
 
43 
catch {unset a}
44 
set a(xyz) 2
45 
set a(44) 3
46 
set {a(a long name)} test
47 
test set-old-2.1 {basic array operations} {
48 
    lsort [array names a]
49 
} {44 {a long name} xyz}
50 
test set-old-2.2 {basic array operations} {
51 
    set a(44)
52 
} 3
53 
test set-old-2.3 {basic array operations} {
54 
    set a(xyz)
55 
} 2
56 
test set-old-2.4 {basic array operations} {
57 
    set "a(a long name)"
58 
} test
59 
test set-old-2.5 {basic array operations} {
60 
    list [catch {set a(other)} msg] $msg
61 
} {1 {can't read "a(other)": no such element in array}}
62 
test set-old-2.6 {basic array operations} {
63 
    list [catch {set a} msg] $msg
64 
} {1 {can't read "a": variable is array}}
65 
test set-old-2.7 {basic array operations} {
66 
    format %s $a(44)
67 
} 3
68 
test set-old-2.8 {basic array operations} {
69 
    format %s $a(a long name)
70 
} test
71 
unset a(44)
72 
test set-old-2.9 {basic array operations} {
73 
    lsort [array names a]
74 
} {{a long name} xyz}
75 
test set-old-2.10 {basic array operations} {
76 
    catch {unset b}
77 
    list [catch {set b(123)} msg] $msg
78 
} {1 {can't read "b(123)": no such variable}}
79 
test set-old-2.11 {basic array operations} {
80 
    catch {unset b}
81 
    set b 44
82 
    list [catch {set b(123)} msg] $msg
83 
} {1 {can't read "b(123)": variable isn't array}}
84 
test set-old-2.12 {basic array operations} {
85 
    list [catch {set a 14} msg] $msg
86 
} {1 {can't set "a": variable is array}}
87 
unset a
88 
test set-old-2.13 {basic array operations} {
89 
    list [catch {set a(xyz)} msg] $msg
90 
} {1 {can't read "a(xyz)": no such variable}}
91 
 
92 
# Test the set commands, and exercise the corner cases of the code
93 
# that parses array references into two parts.
94 
 
95 
test set-old-3.1 {set command} {
96 
    list [catch {set} msg] $msg
97 
} {1 {wrong # args: should be "set varName ?newValue?"}}
98 
test set-old-3.2 {set command} {
99 
    list [catch {set x y z} msg] $msg
100 
} {1 {wrong # args: should be "set varName ?newValue?"}}
101 
test set-old-3.3 {set command} {
102 
    catch {unset a}
103 
    list [catch {set a} msg] $msg
104 
} {1 {can't read "a": no such variable}}
105 
test set-old-3.4 {set command} {
106 
    catch {unset a}
107 
    set a(14) 83
108 
    list [catch {set a 22} msg] $msg
109 
} {1 {can't set "a": variable is array}}
110 
 
111 
# Test the corner-cases of parsing array names, using set and unset.
112 
 
113 
test set-old-4.1 {parsing array names} {
114 
    catch {unset a}
115 
    set a(()) 44
116 
    list [catch {array names a} msg] $msg
117 
} {0 ()}
118 
test set-old-4.2 {parsing array names} {
119 
    catch {unset a a(abcd}
120 
    set a(abcd 33
121 
    info exists a(abcd
122 
} 1
123 
test set-old-4.3 {parsing array names} {
124 
    catch {unset a a(abcd}
125 
    set a(abcd 33
126 
    list [catch {array names a} msg] $msg
127 
} {0 {}}
128 
test set-old-4.4 {parsing array names} {
129 
    catch {unset a abcd)}
130 
    set abcd) 33
131 
    info exists abcd)
132 
} 1
133 
test set-old-4.5 {parsing array names} {
134 
    set a(bcd yyy
135 
    catch {unset a}
136 
    list [catch {set a(bcd} msg] $msg
137 
} {0 yyy}
138 
test set-old-4.6 {parsing array names} {
139 
    catch {unset a}
140 
    set a 44
141 
    list [catch {set a(bcd test} msg] $msg
142 
} {0 test}
143 
 
144 
# Errors in reading variables
145 
 
146 
test set-old-5.1 {errors in reading variables} {
147 
    catch {unset a}
148 
    list [catch {set a} msg] $msg
149 
} {1 {can't read "a": no such variable}}
150 
test set-old-5.2 {errors in reading variables} {
151 
    catch {unset a}
152 
    set a 44
153 
    list [catch {set a(18)} msg] $msg
154 
} {1 {can't read "a(18)": variable isn't array}}
155 
test set-old-5.3 {errors in reading variables} {
156 
    catch {unset a}
157 
    set a(6) 44
158 
    list [catch {set a(18)} msg] $msg
159 
} {1 {can't read "a(18)": no such element in array}}
160 
test set-old-5.4 {errors in reading variables} {
161 
    catch {unset a}
162 
    set a(6) 44
163 
    list [catch {set a} msg] $msg
164 
} {1 {can't read "a": variable is array}}
165 
 
166 
# Errors and other special cases in writing variables
167 
 
168 
test set-old-6.1 {creating array during write} {
169 
    catch {unset a}
170 
    trace var a rwu ignore
171 
    list [catch {set a(14) 186} msg] $msg [array names a]
172 
} {0 186 14}
173 
test set-old-6.2 {errors in writing variables} {
174 
    catch {unset a}
175 
    set a xxx
176 
    list [catch {set a(14) 186} msg] $msg
177 
} {1 {can't set "a(14)": variable isn't array}}
178 
test set-old-6.3 {errors in writing variables} {
179 
    catch {unset a}
180 
    set a(100) yyy
181 
    list [catch {set a 2} msg] $msg
182 
} {1 {can't set "a": variable is array}}
183 
test set-old-6.4 {expanding variable size} {
184 
    catch {unset a}
185 
    list [set a short] [set a "longer name"] [set a "even longer name"] \
186 
            [set a "a much much truly longer name"]
187 
} {short {longer name} {even longer name} {a much much truly longer name}}
188 
 
189 
# Unset command, Tcl_UnsetVar procedures
190 
 
191 
test set-old-7.1 {unset command} {
192 
    catch {unset a}; catch {unset b}; catch {unset c}; catch {unset d}
193 
    set a 44
194 
    set b 55
195 
    set c 66
196 
    set d 77
197 
    unset a b c
198 
    list [catch {set a(0) 0}] [catch {set b(0) 0}] [catch {set c(0) 0}] \
199 
            [catch {set d(0) 0}]
200 
} {0 0 0 1}
201 
test set-old-7.2 {unset command} {
202 
    list [catch {unset} msg] $msg
203 
} {1 {wrong # args: should be "unset varName ?varName ...?"}}
204 
test set-old-7.3 {unset command} {
205 
    catch {unset a}
206 
    list [catch {unset a} msg] $msg
207 
} {1 {can't unset "a": no such variable}}
208 
test set-old-7.4 {unset command} {
209 
    catch {unset a}
210 
    set a 44
211 
    list [catch {unset a(14)} msg] $msg
212 
} {1 {can't unset "a(14)": variable isn't array}}
213 
test set-old-7.5 {unset command} {
214 
    catch {unset a}
215 
    set a(0) xx
216 
    list [catch {unset a(14)} msg] $msg
217 
} {1 {can't unset "a(14)": no such element in array}}
218 
test set-old-7.6 {unset command} {
219 
    catch {unset a}; catch {unset b}; catch {unset c}
220 
    set a foo
221 
    set c gorp
222 
    list [catch {unset a a a(14)} msg] $msg [info exists c]
223 
} {1 {can't unset "a": no such variable} 1}
224 
test set-old-7.7 {unsetting globals from within procedures} {
225 
    set y 0
226 
    proc p1 {} {
227 
        global y
228 
        set z [p2]
229 
        return [list $z [catch {set y} msg] $msg]
230 
    }
231 
    proc p2 {} {global y; unset y; list [catch {set y} msg] $msg}
232 
    p1
233 
} {{1 {can't read "y": no such variable}} 1 {can't read "y": no such variable}}
234 
test set-old-7.8 {unsetting globals from within procedures} {
235 
    set y 0
236 
    proc p1 {} {
237 
        global y
238 
        p2
239 
        return [list [catch {set y 44} msg] $msg]
240 
    }
241 
    proc p2 {} {global y; unset y}
242 
    concat [p1] [list [catch {set y} msg] $msg]
243 
} {0 44 0 44}
244 
test set-old-7.9 {unsetting globals from within procedures} {
245 
    set y 0
246 
    proc p1 {} {
247 
        global y
248 
        unset y
249 
        return [list [catch {set y 55} msg] $msg]
250 
    }
251 
    concat [p1] [list [catch {set y} msg] $msg]
252 
} {0 55 0 55}
253 
test set-old-7.10 {unset command} {
254 
    catch {unset a}
255 
    set a(14) 22
256 
    unset a(14)
257 
    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
258 
} {1 {can't read "a(14)": no such element in array} 0 {}}
259 
test set-old-7.11 {unset command} {
260 
    catch {unset a}
261 
    set a(14) 22
262 
    unset a
263 
    list [catch {set a(14)} msg] $msg [catch {array names a} msg2] $msg2
264 
} {1 {can't read "a(14)": no such variable} 0 {}}
265 
 
266 
# Array command.
267 
 
268 
test set-old-8.1 {array command} {
269 
    list [catch {array} msg] $msg
270 
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
271 
test set-old-8.2 {array command} {
272 
    list [catch {array a} msg] $msg
273 
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
274 
test set-old-8.3 {array command} {
275 
    catch {unset a}
276 
    list [catch {array anymore a b} msg] $msg
277 
} {1 {"a" isn't an array}}
278 
test set-old-8.4 {array command} {
279 
    catch {unset a}
280 
    set a 44
281 
    list [catch {array anymore a b} msg] $msg
282 
} {1 {"a" isn't an array}}
283 
test set-old-8.5 {array command} {
284 
    proc foo {} {
285 
        set a 44
286 
        upvar 0 a x
287 
        list [catch {array anymore x b} msg] $msg
288 
    }
289 
    foo
290 
} {1 {"x" isn't an array}}
291 
test set-old-8.6 {array command} {
292 
    catch {unset a}
293 
    set a(22) 3
294 
    list [catch {array gorp a} msg] $msg
295 
} {1 {bad option "gorp": must be anymore, donesearch, exists, get, names, nextelement, set, size, or startsearch}}
296 
test set-old-8.7 {array command, anymore option} {
297 
    catch {unset a}
298 
    list [catch {array anymore a x} msg] $msg
299 
} {1 {"a" isn't an array}}
300 
test set-old-8.8 {array command, anymore option, array doesn't exist yet but has compiler-allocated procedure slot} {
301 
    proc foo {x} {
302 
        if {$x==1} {
303 
            return [array anymore a x]
304 
        }
305 
        set a(x) 123
306 
    }
307 
    list [catch {foo 1} msg] $msg
308 
} {1 {"a" isn't an array}}
309 
test set-old-8.9 {array command, donesearch option} {
310 
    catch {unset a}
311 
    list [catch {array donesearch a x} msg] $msg
312 
} {1 {"a" isn't an array}}
313 
test set-old-8.10 {array command, donesearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
314 
    proc foo {x} {
315 
        if {$x==1} {
316 
            return [array donesearch a x]
317 
        }
318 
        set a(x) 123
319 
    }
320 
    list [catch {foo 1} msg] $msg
321 
} {1 {"a" isn't an array}}
322 
test set-old-8.11 {array command, exists option} {
323 
    list [catch {array exists a b} msg] $msg
324 
} {1 {wrong # args: should be "array exists arrayName"}}
325 
test set-old-8.12 {array command, exists option} {
326 
    catch {unset a}
327 
    array exists a
328 
} {0}
329 
test set-old-8.13 {array command, exists option} {
330 
    catch {unset a}
331 
    set a(0) 1
332 
    array exists a
333 
} {1}
334 
test set-old-8.14 {array command, exists option, array doesn't exist yet but has compiler-allocated procedure slot} {
335 
    proc foo {x} {
336 
        if {$x==1} {
337 
            return [array exists a]
338 
        }
339 
        set a(x) 123
340 
    }
341 
    list [catch {foo 1} msg] $msg
342 
} {0 0}
343 
test set-old-8.15 {array command, get option} {
344 
    list [catch {array get} msg] $msg
345 
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
346 
test set-old-8.16 {array command, get option} {
347 
    list [catch {array get a b c} msg] $msg
348 
} {1 {wrong # args: should be "array get arrayName ?pattern?"}}
349 
test set-old-8.17 {array command, get option} {
350 
    catch {unset a}
351 
    array get a
352 
} {}
353 
test set-old-8.18 {array command, get option} {
354 
    catch {unset a}
355 
    set a(22) 3
356 
    set {a(long name)} {}
357 
    array get a
358 
} {22 3 {long name} {}}
359 
test set-old-8.19 {array command, get option (unset variable)} {
360 
    catch {unset a}
361 
    set a(x) 3
362 
    trace var a(y) w ignore
363 
    array get a
364 
} {x 3}
365 
test set-old-8.20 {array command, get option, with pattern} {
366 
    catch {unset a}
367 
    set a(x1) 3
368 
    set a(x2) 4
369 
    set a(x3) 5
370 
    set a(b1) 24
371 
    set a(b2) 25
372 
    array get a x*
373 
} {x1 3 x2 4 x3 5}
374 
test set-old-8.21 {array command, get option, array doesn't exist yet but has compiler-allocated procedure slot} {
375 
    proc foo {x} {
376 
        if {$x==1} {
377 
            return [array get a]
378 
        }
379 
        set a(x) 123
380 
    }
381 
    list [catch {foo 1} msg] $msg
382 
} {0 {}}
383 
test set-old-8.22 {array command, names option} {
384 
    catch {unset a}
385 
    set a(22) 3
386 
    list [catch {array names a 4 5} msg] $msg
387 
} {1 {wrong # args: should be "array names arrayName ?pattern?"}}
388 
test set-old-8.19 {array command, names option} {
389 
    catch {unset a}
390 
    array names a
391 
} {}
392 
test set-old-8.23 {array command, names option} {
393 
    catch {unset a}
394 
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
395 
    list [catch {lsort [array names a]} msg] $msg
396 
} {0 {22 Textual_name {name with spaces}}}
397 
test set-old-8.24 {array command, names option} {
398 
    catch {unset a}
399 
    set a(22) 3; set a(33) 44;
400 
    trace var a(xxx) w ignore
401 
    list [catch {lsort [array names a]} msg] $msg
402 
} {0 {22 33}}
403 
test set-old-8.25 {array command, names option} {
404 
    catch {unset a}
405 
    set a(22) 3; set a(33) 44;
406 
    trace var a(xxx) w ignore
407 
    set a(xxx) value
408 
    list [catch {lsort [array names a]} msg] $msg
409 
} {0 {22 33 xxx}}
410 
test set-old-8.26 {array command, names option} {
411 
    catch {unset a}
412 
    set a(axy) 3
413 
    set a(bxy) 44
414 
    set a(no) yes
415 
    set a(xxx) value
416 
    list [lsort [array names a *xy]] [lsort [array names a]]
417 
} {{axy bxy} {axy bxy no xxx}}
418 
test set-old-8.27 {array command, names option, array doesn't exist yet but has compiler-allocated procedure slot} {
419 
    proc foo {x} {
420 
        if {$x==1} {
421 
            return [array names a]
422 
        }
423 
        set a(x) 123
424 
    }
425 
    list [catch {foo 1} msg] $msg
426 
} {0 {}}
427 
test set-old-8.28 {array command, nextelement option} {
428 
    list [catch {array nextelement a} msg] $msg
429 
} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
430 
test set-old-8.29 {array command, nextelement option} {
431 
    catch {unset a}
432 
    list [catch {array nextelement a b} msg] $msg
433 
} {1 {"a" isn't an array}}
434 
test set-old-8.30 {array command, nextelement option, array doesn't exist yet but has compiler-allocated procedure slot} {
435 
    proc foo {x} {
436 
        if {$x==1} {
437 
            return [array nextelement a b]
438 
        }
439 
        set a(x) 123
440 
    }
441 
    list [catch {foo 1} msg] $msg
442 
} {1 {"a" isn't an array}}
443 
test set-old-8.31 {array command, set option} {
444 
    list [catch {array set a} msg] $msg
445 
} {1 {wrong # args: should be "array set arrayName list"}}
446 
test set-old-8.32 {array command, set option} {
447 
    list [catch {array set a 1 2} msg] $msg
448 
} {1 {wrong # args: should be "array set arrayName list"}}
449 
test set-old-8.33 {array command, set option} {
450 
    list [catch {array set a "a \{ c"} msg] $msg
451 
} {1 {unmatched open brace in list}}
452 
test set-old-8.34 {array command, set option} {
453 
    catch {unset a}
454 
    set a 44
455 
    list [catch {array set a {a b c d}} msg] $msg
456 
} {1 {can't set "a(a)": variable isn't array}}
457 
test set-old-8.35 {array command, set option} {
458 
    catch {unset a}
459 
    set a(xx) yy
460 
    array set a {b c d e}
461 
    array get a
462 
} {d e xx yy b c}
463 
test set-old-8.36 {array command, set option, array doesn't exist yet but has compiler-allocated procedure slot} {
464 
    proc foo {x} {
465 
        if {$x==1} {
466 
            return [array set a {x 0}]
467 
        }
468 
        set a(x)
469 
    }
470 
    list [catch {foo 1} msg] $msg
471 
} {0 {}}
472 
test set-old-8.37 {array command, set option} {
473 
    catch {unset aVaRnAmE}
474 
    array set aVaRnAmE {}
475 
    list [info exists aVaRnAmE] [catch {set aVaRnAmE} msg] $msg
476 
} {1 1 {can't read "aVaRnAmE": variable is array}}
477 
test set-old-8.37.1 {array command, set scalar} {
478 
    catch {unset aVaRnAmE}
479 
    set aVaRnAmE 1
480 
    list [catch {array set aVaRnAmE {}} msg] $msg
481 
} {1 {can't array set "aVaRnAmE": variable isn't array}}
482 
test set-old-8.37.2 {array command, set alias} {
483 
    catch {unset aVaRnAmE}
484 
    upvar 0 aVaRnAmE anAliAs
485 
    array set anAliAs {}
486 
    list [array exists aVaRnAmE] [catch {set anAliAs} msg] $msg
487 
} {1 1 {can't read "anAliAs": variable is array}}
488 
test set-old-8.37.3 {array command, set element alias} {
489 
    catch {unset aVaRnAmE}
490 
    list [catch {upvar 0 aVaRnAmE(elem) elemAliAs}] \
491 
            [catch {array set elemAliAs {}} msg] $msg
492 
} {0 1 {can't array set "elemAliAs": variable isn't array}}
493 
test set-old-8.37.4 {array command, empty set with populated array} {
494 
    catch {unset aVaRnAmE}
495 
    array set aVaRnAmE [list e1 v1 e2 v2]
496 
    array set aVaRnAmE {}
497 
    array set aVaRnAmE [list e3 v3]
498 
    list [lsort [array names aVaRnAmE]] [catch {set aVaRnAmE(e2)} msg] $msg
499 
} {{e1 e2 e3} 0 v2}
500 
test set-old-8.38 {array command, size option} {
501 
    catch {unset a}
502 
    array size a
503 
} {0}
504 
test set-old-8.39 {array command, size option} {
505 
    list [catch {array size a 4} msg] $msg
506 
} {1 {wrong # args: should be "array size arrayName"}}
507 
test set-old-8.40 {array command, size option} {
508 
    catch {unset a}
509 
    array size a
510 
} {0}
511 
test set-old-8.41 {array command, size option} {
512 
    catch {unset a}
513 
    set a(22) 3; set a(Textual_name) 44; set "a(name with spaces)" xxx
514 
    list [catch {array size a} msg] $msg
515 
} {0 3}
516 
test set-old-8.42 {array command, size option} {
517 
    catch {unset a}
518 
    set a(22) 3; set a(xx) 44; set a(y) xxx
519 
    unset a(22) a(y) a(xx)
520 
    list [catch {array size a} msg] $msg
521 
} {0 0}
522 
test set-old-8.43 {array command, size option} {
523 
    catch {unset a}
524 
    set a(22) 3;
525 
    trace var a(33) rwu ignore
526 
    list [catch {array size a} msg] $msg
527 
} {0 1}
528 
test set-old-8.44 {array command, size option, array doesn't exist yet but has compiler-allocated procedure slot} {
529 
    proc foo {x} {
530 
        if {$x==1} {
531 
            return [array size a]
532 
        }
533 
        set a(x) 123
534 
    }
535 
    list [catch {foo 1} msg] $msg
536 
} {0 0}
537 
test set-old-8.45 {array command, startsearch option} {
538 
    list [catch {array startsearch a b} msg] $msg
539 
} {1 {wrong # args: should be "array startsearch arrayName"}}
540 
test set-old-8.46 {array command, startsearch option} {
541 
    catch {unset a}
542 
    list [catch {array startsearch a} msg] $msg
543 
} {1 {"a" isn't an array}}
544 
test set-old-8.47 {array command, startsearch option, array doesn't exist yet but has compiler-allocated procedure slot} {
545 
    catch {rename p ""}
546 
    proc p {x} {
547 
        if {$x==1} {
548 
            return [array startsearch a]
549 
        }
550 
        set a(x) 123
551 
    }
552 
    list [catch {p 1} msg] $msg
553 
} {1 {"a" isn't an array}}
554 
 
555 
test set-old-9.1 {ids for array enumeration} {
556 
    catch {unset a}
557 
    set a(a) 1
558 
    list [array st a] [array st a] [array done a s-1-a; array st a] \
559 
            [array done a s-2-a; array d a s-3-a; array start a]
560 
} {s-1-a s-2-a s-3-a s-1-a}
561 
test set-old-9.2 {array enumeration} {
562 
    catch {unset a}
563 
    set a(a) 1
564 
    set a(b) 1
565 
    set a(c) 1
566 
    set x [array startsearch a]
567 
    list [array nextelement a $x] [array ne a $x] [array next a $x] \
568 
            [array next a $x] [array next a $x]
569 
} {a b c {} {}}
570 
test set-old-9.3 {array enumeration} {
571 
    catch {unset a}
572 
    set a(a) 1
573 
    set a(b) 1
574 
    set a(c) 1
575 
    set x [array startsearch a]
576 
    set y [array startsearch a]
577 
    set z [array startsearch a]
578 
    list [array nextelement a $x] [array ne a $x] \
579 
            [array next a $y] [array next a $z] [array next a $y] \
580 
            [array next a $z] [array next a $y] [array next a $z] \
581 
            [array next a $y] [array next a $z] [array next a $x] \
582 
            [array next a $x]
583 
} {a b a a b b c c {} {} c {}}
584 
test set-old-9.4 {array enumeration: stopping searches} {
585 
    catch {unset a}
586 
    set a(a) 1
587 
    set a(b) 1
588 
    set a(c) 1
589 
    set x [array startsearch a]
590 
    set y [array startsearch a]
591 
    set z [array startsearch a]
592 
    list [array next a $x] [array next a $x] [array next a $y] \
593 
            [array done a $z; array next a $x] \
594 
            [array done a $x; array next a $y] [array next a $y]
595 
} {a b a c b c}
596 
test set-old-9.5 {array enumeration: stopping searches} {
597 
    catch {unset a}
598 
    set a(a) 1
599 
    set x [array startsearch a]
600 
    array done a $x
601 
    list [catch {array next a $x} msg] $msg
602 
} {1 {couldn't find search "s-1-a"}}
603 
test set-old-9.6 {array enumeration: searches automatically stopped} {
604 
    catch {unset a}
605 
    set a(a) 1
606 
    set x [array startsearch a]
607 
    set y [array startsearch a]
608 
    set a(b) 1
609 
    list [catch {array next a $x} msg] $msg \
610 
            [catch {array next a $y} msg2] $msg2
611 
} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
612 
test set-old-9.7 {array enumeration: searches automatically stopped} {
613 
    catch {unset a}
614 
    set a(a) 1
615 
    set x [array startsearch a]
616 
    set y [array startsearch a]
617 
    set a(a) 2
618 
    list [catch {array next a $x} msg] $msg \
619 
            [catch {array next a $y} msg2] $msg2
620 
} {0 a 0 a}
621 
test set-old-9.8 {array enumeration: searches automatically stopped} {
622 
    catch {unset a}
623 
    set a(a) 1
624 
    set a(c) 2
625 
    set x [array startsearch a]
626 
    set y [array startsearch a]
627 
    catch {unset a(c)}
628 
    list [catch {array next a $x} msg] $msg \
629 
            [catch {array next a $y} msg2] $msg2
630 
} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
631 
test set-old-9.9 {array enumeration: searches automatically stopped} {
632 
    catch {unset a}
633 
    set a(a) 1
634 
    set x [array startsearch a]
635 
    set y [array startsearch a]
636 
    catch {unset a(c)}
637 
    list [catch {array next a $x} msg] $msg \
638 
            [catch {array next a $y} msg2] $msg2
639 
} {0 a 0 a}
640 
test set-old-9.10 {array enumeration: searches automatically stopped} {
641 
    catch {unset a}
642 
    set a(a) 1
643 
    set x [array startsearch a]
644 
    set y [array startsearch a]
645 
    trace var a(b) r {}
646 
    list [catch {array next a $x} msg] $msg \
647 
            [catch {array next a $y} msg2] $msg2
648 
} {1 {couldn't find search "s-1-a"} 1 {couldn't find search "s-2-a"}}
649 
test set-old-9.11 {array enumeration: searches automatically stopped} {
650 
    catch {unset a}
651 
    set a(a) 1
652 
    set x [array startsearch a]
653 
    set y [array startsearch a]
654 
    trace var a(a) r {}
655 
    list [catch {array next a $x} msg] $msg \
656 
            [catch {array next a $y} msg2] $msg2
657 
} {0 a 0 a}
658 
test set-old-9.12 {array enumeration with traced undefined elements} {
659 
    catch {unset a}
660 
    set a(a) 1
661 
    trace var a(b) r {}
662 
    set x [array startsearch a]
663 
    list [array next a $x] [array next a $x]
664 
} {a {}}
665 
 
666 
test set-old-10.1 {array enumeration errors} {
667 
    list [catch {array start} msg] $msg
668 
} {1 {wrong # args: should be "array option arrayName ?arg ...?"}}
669 
test set-old-10.2 {array enumeration errors} {
670 
    list [catch {array start a b} msg] $msg
671 
} {1 {wrong # args: should be "array startsearch arrayName"}}
672 
test set-old-10.3 {array enumeration errors} {
673 
    catch {unset a}
674 
    list [catch {array start a} msg] $msg
675 
} {1 {"a" isn't an array}}
676 
test set-old-10.4 {array enumeration errors} {
677 
    catch {unset a}
678 
    set a(a) 1
679 
    set x [array startsearch a]
680 
    list [catch {array next a} msg] $msg
681 
} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
682 
test set-old-10.5 {array enumeration errors} {
683 
    catch {unset a}
684 
    set a(a) 1
685 
    set x [array startsearch a]
686 
    list [catch {array next a b c} msg] $msg
687 
} {1 {wrong # args: should be "array nextelement arrayName searchId"}}
688 
test set-old-10.6 {array enumeration errors} {
689 
    catch {unset a}
690 
    set a(a) 1
691 
    set x [array startsearch a]
692 
    list [catch {array next a a-1-a} msg] $msg
693 
} {1 {illegal search identifier "a-1-a"}}
694 
test set-old-10.7 {array enumeration errors} {
695 
    catch {unset a}
696 
    set a(a) 1
697 
    set x [array startsearch a]
698 
    list [catch {array next a sx1-a} msg] $msg
699 
} {1 {illegal search identifier "sx1-a"}}
700 
test set-old-10.8 {array enumeration errors} {
701 
    catch {unset a}
702 
    set a(a) 1
703 
    set x [array startsearch a]
704 
    list [catch {array next a s--a} msg] $msg
705 
} {1 {illegal search identifier "s--a"}}
706 
test set-old-10.9 {array enumeration errors} {
707 
    catch {unset a}
708 
    set a(a) 1
709 
    set x [array startsearch a]
710 
    list [catch {array next a s-1-b} msg] $msg
711 
} {1 {search identifier "s-1-b" isn't for variable "a"}}
712 
test set-old-10.10 {array enumeration errors} {
713 
    catch {unset a}
714 
    set a(a) 1
715 
    set x [array startsearch a]
716 
    list [catch {array next a s-1ba} msg] $msg
717 
} {1 {illegal search identifier "s-1ba"}}
718 
test set-old-10.11 {array enumeration errors} {
719 
    catch {unset a}
720 
    set a(a) 1
721 
    set x [array startsearch a]
722 
    list [catch {array next a s-2-a} msg] $msg
723 
} {1 {couldn't find search "s-2-a"}}
724 
test set-old-10.12 {array enumeration errors} {
725 
    list [catch {array done a} msg] $msg
726 
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
727 
test set-old-10.13 {array enumeration errors} {
728 
    list [catch {array done a b c} msg] $msg
729 
} {1 {wrong # args: should be "array donesearch arrayName searchId"}}
730 
test set-old-10.14 {array enumeration errors} {
731 
    list [catch {array done a b} msg] $msg
732 
} {1 {illegal search identifier "b"}}
733 
test set-old-10.15 {array enumeration errors} {
734 
    list [catch {array anymore a} msg] $msg
735 
} {1 {wrong # args: should be "array anymore arrayName searchId"}}
736 
test set-old-10.16 {array enumeration errors} {
737 
    list [catch {array any a b c} msg] $msg
738 
} {1 {wrong # args: should be "array anymore arrayName searchId"}}
739 
test set-old-10.17 {array enumeration errors} {
740 
    catch {unset a}
741 
    set a(0) 44
742 
    list [catch {array any a bogus} msg] $msg
743 
} {1 {illegal search identifier "bogus"}}
744 
 
745 
# Array enumeration with "anymore" option
746 
 
747 
test set-old-11.1 {array anymore option} {
748 
    catch {unset a}
749 
    set a(a) 1
750 
    set a(b) 2
751 
    set a(c) 3
752 
    array startsearch a
753 
    list [array anymore a s-1-a] [array next a s-1-a] \
754 
            [array anymore a s-1-a] [array next a s-1-a] \
755 
            [array anymore a s-1-a] [array next a s-1-a] \
756 
            [array anymore a s-1-a] [array next a s-1-a]
757 
} {1 a 1 b 1 c 0 {}}
758 
test set-old-11.2 {array anymore option} {
759 
    catch {unset a}
760 
    set a(a) 1
761 
    set a(b) 2
762 
    set a(c) 3
763 
    array startsearch a
764 
    list [array next a s-1-a] [array next a s-1-a] \
765 
            [array anymore a s-1-a] [array next a s-1-a] \
766 
            [array next a s-1-a] [array anymore a s-1-a]
767 
} {a b 1 c {} 0}
768 
 
769 
# Special check to see that the value of a variable is handled correctly
770 
# if it is returned as the result of a procedure (must not free the variable
771 
# string while deleting the call frame).  Errors will only be detected if
772 
# a memory consistency checker such as Purify is being used.
773 
 
774 
test set-old-12.1 {cleanup on procedure return} {
775 
    proc foo {} {
776 
        set x 12345
777 
    }
778 
    foo
779 
} 12345
780 
test set-old-12.2 {cleanup on procedure return} {
781 
    proc foo {} {
782 
        set x(1) 23456
783 
    }
784 
    foo
785 
} 23456
786 
 
787 
# Must delete variables when done, since these arrays get used as
788 
# scalars by other tests.
789 
 
790 
catch {unset a}
791 
catch {unset b}
792 
catch {unset c}
793 
catch {unset aVaRnAmE}
794 
return ""

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.