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

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [tcl/] [tests/] [trace.test] - Blame information for rev 1774

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# Commands covered:  trace
2 
#
3 
# This file contains a collection of tests for one or more of the Tcl
4 
# built-in commands.  Sourcing this file into Tcl runs the tests and
5 
# generates output for errors.  No output means no errors were found.
6 
#
7 
# Copyright (c) 1991-1993 The Regents of the University of California.
8 
# Copyright (c) 1994 Sun Microsystems, Inc.
9 
#
10 
# See the file "license.terms" for information on usage and redistribution
11 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12 
#
13 
# RCS: @(#) $Id: trace.test,v 1.1.1.1 2002-01-16 10:25:36 markom Exp $
14 
 
15 
if {[string compare test [info procs test]] == 1} then {source defs}
16 
 
17 
proc traceScalar {name1 name2 op} {
18 
    global info
19 
    set info [list $name1 $name2 $op [catch {uplevel set $name1} msg] $msg]
20 
}
21 
proc traceScalarAppend {name1 name2 op} {
22 
    global info
23 
    lappend info $name1 $name2 $op [catch {uplevel set $name1} msg] $msg
24 
}
25 
proc traceArray {name1 name2 op} {
26 
    global info
27 
    set info [list $name1 $name2 $op [catch {uplevel set [set name1]($name2)} msg] $msg]
28 
}
29 
proc traceArray2 {name1 name2 op} {
30 
    global info
31 
    set info [list $name1 $name2 $op]
32 
}
33 
proc traceProc {name1 name2 op} {
34 
    global info
35 
    set info [concat $info [list $name1 $name2 $op]]
36 
}
37 
proc traceTag {tag args} {
38 
    global info
39 
    set info [concat $info $tag]
40 
}
41 
proc traceError {args} {
42 
    error "trace returned error"
43 
}
44 
proc traceCheck {cmd args} {
45 
    global info
46 
    set info [list [catch $cmd msg] $msg]
47 
}
48 
proc traceCrtElement {value name1 name2 op} {
49 
    uplevel set ${name1}($name2) $value
50 
}
51 
 
52 
# Read-tracing on variables
53 
 
54 
test trace-1.1 {trace variable reads} {
55 
    catch {unset x}
56 
    set info {}
57 
    trace var x r traceScalar
58 
    list [catch {set x} msg] $msg $info
59 
} {1 {can't read "x": no such variable} {x {} r 1 {can't read "x": no such variable}}}
60 
test trace-1.2 {trace variable reads} {
61 
    catch {unset x}
62 
    set x 123
63 
    set info {}
64 
    trace var x r traceScalar
65 
    list [catch {set x} msg] $msg $info
66 
} {0 123 {x {} r 0 123}}
67 
test trace-1.3 {trace variable reads} {
68 
    catch {unset x}
69 
    set info {}
70 
    trace var x r traceScalar
71 
    set x 123
72 
    set info
73 
} {}
74 
test trace-1.4 {trace array element reads} {
75 
    catch {unset x}
76 
    set info {}
77 
    trace var x(2) r traceArray
78 
    list [catch {set x(2)} msg] $msg $info
79 
} {1 {can't read "x(2)": no such element in array} {x 2 r 1 {can't read "x(2)": no such element in array}}}
80 
test trace-1.5 {trace array element reads} {
81 
    catch {unset x}
82 
    set x(2) zzz
83 
    set info {}
84 
    trace var x(2) r traceArray
85 
    list [catch {set x(2)} msg] $msg $info
86 
} {0 zzz {x 2 r 0 zzz}}
87 
test trace-1.6 {trace array element reads} {
88 
    catch {unset x}
89 
    set info {}
90 
    trace variable x r traceArray2
91 
    proc p {} {
92 
        global x
93 
        set x(2) willi
94 
        return $x(2)
95 
    }
96 
    list [catch {p} msg] $msg $info
97 
} {0 willi {x 2 r}}
98 
test trace-1.7 {trace array element reads, create element undefined if nonexistant} {
99 
    catch {unset x}
100 
    set info {}
101 
    trace variable x r q
102 
    proc q {name1 name2 op} {
103 
        global info
104 
        set info [list $name1 $name2 $op]
105 
        global $name1
106 
        set ${name1}($name2) wolf
107 
    }
108 
    proc p {} {
109 
        global x
110 
        set x(X) willi
111 
        return $x(Y)
112 
    }
113 
    list [catch {p} msg] $msg $info
114 
} {0 wolf {x Y r}}
115 
test trace-1.8 {trace reads on whole arrays} {
116 
    catch {unset x}
117 
    set info {}
118 
    trace var x r traceArray
119 
    list [catch {set x(2)} msg] $msg $info
120 
} {1 {can't read "x(2)": no such variable} {}}
121 
test trace-1.9 {trace reads on whole arrays} {
122 
    catch {unset x}
123 
    set x(2) zzz
124 
    set info {}
125 
    trace var x r traceArray
126 
    list [catch {set x(2)} msg] $msg $info
127 
} {0 zzz {x 2 r 0 zzz}}
128 
test trace-1.10 {trace variable reads} {
129 
    catch {unset x}
130 
    set x 444
131 
    set info {}
132 
    trace var x r traceScalar
133 
    unset x
134 
    set info
135 
} {}
136 
 
137 
# Basic write-tracing on variables
138 
 
139 
test trace-2.1 {trace variable writes} {
140 
    catch {unset x}
141 
    set info {}
142 
    trace var x w traceScalar
143 
    set x 123
144 
    set info
145 
} {x {} w 0 123}
146 
test trace-2.2 {trace writes to array elements} {
147 
    catch {unset x}
148 
    set info {}
149 
    trace var x(33) w traceArray
150 
    set x(33) 444
151 
    set info
152 
} {x 33 w 0 444}
153 
test trace-2.3 {trace writes on whole arrays} {
154 
    catch {unset x}
155 
    set info {}
156 
    trace var x w traceArray
157 
    set x(abc) qq
158 
    set info
159 
} {x abc w 0 qq}
160 
test trace-2.4 {trace variable writes} {
161 
    catch {unset x}
162 
    set x 1234
163 
    set info {}
164 
    trace var x w traceScalar
165 
    set x
166 
    set info
167 
} {}
168 
test trace-2.5 {trace variable writes} {
169 
    catch {unset x}
170 
    set x 1234
171 
    set info {}
172 
    trace var x w traceScalar
173 
    unset x
174 
    set info
175 
} {}
176 
 
177 
# append no longer triggers read traces when fetching the old values of
178 
# variables before doing the append operation. However, lappend _does_
179 
# still trigger these read traces. Also lappend triggers only one write
180 
# trace: after appending all arguments to the list.
181 
 
182 
test trace-3.1 {trace variable read-modify-writes} {
183 
    catch {unset x}
184 
    set info {}
185 
    trace var x r traceScalarAppend
186 
    append x 123
187 
    append x 456
188 
    lappend x 789
189 
    set info
190 
} {x {} r 0 123456}
191 
test trace-3.2 {trace variable read-modify-writes} {
192 
    catch {unset x}
193 
    set info {}
194 
    trace var x rw traceScalarAppend
195 
    append x 123
196 
    lappend x 456
197 
    set info
198 
} {x {} w 0 123 x {} r 0 123 x {} w 0 {123 456}}
199 
 
200 
# Basic unset-tracing on variables
201 
 
202 
test trace-4.1 {trace variable unsets} {
203 
    catch {unset x}
204 
    set info {}
205 
    trace var x u traceScalar
206 
    catch {unset x}
207 
    set info
208 
} {x {} u 1 {can't read "x": no such variable}}
209 
test trace-4.2 {variable mustn't exist during unset trace} {
210 
    catch {unset x}
211 
    set x 1234
212 
    set info {}
213 
    trace var x u traceScalar
214 
    unset x
215 
    set info
216 
} {x {} u 1 {can't read "x": no such variable}}
217 
test trace-4.3 {unset traces mustn't be called during reads and writes} {
218 
    catch {unset x}
219 
    set info {}
220 
    trace var x u traceScalar
221 
    set x 44
222 
    set x
223 
    set info
224 
} {}
225 
test trace-4.4 {trace unsets on array elements} {
226 
    catch {unset x}
227 
    set x(0) 18
228 
    set info {}
229 
    trace var x(1) u traceArray
230 
    catch {unset x(1)}
231 
    set info
232 
} {x 1 u 1 {can't read "x(1)": no such element in array}}
233 
test trace-4.5 {trace unsets on array elements} {
234 
    catch {unset x}
235 
    set x(1) 18
236 
    set info {}
237 
    trace var x(1) u traceArray
238 
    unset x(1)
239 
    set info
240 
} {x 1 u 1 {can't read "x(1)": no such element in array}}
241 
test trace-4.6 {trace unsets on array elements} {
242 
    catch {unset x}
243 
    set x(1) 18
244 
    set info {}
245 
    trace var x(1) u traceArray
246 
    unset x
247 
    set info
248 
} {x 1 u 1 {can't read "x(1)": no such variable}}
249 
test trace-4.7 {trace unsets on whole arrays} {
250 
    catch {unset x}
251 
    set x(1) 18
252 
    set info {}
253 
    trace var x u traceProc
254 
    catch {unset x(0)}
255 
    set info
256 
} {}
257 
test trace-4.8 {trace unsets on whole arrays} {
258 
    catch {unset x}
259 
    set x(1) 18
260 
    set x(2) 144
261 
    set x(3) 14
262 
    set info {}
263 
    trace var x u traceProc
264 
    unset x(1)
265 
    set info
266 
} {x 1 u}
267 
test trace-4.9 {trace unsets on whole arrays} {
268 
    catch {unset x}
269 
    set x(1) 18
270 
    set x(2) 144
271 
    set x(3) 14
272 
    set info {}
273 
    trace var x u traceProc
274 
    unset x
275 
    set info
276 
} {x {} u}
277 
 
278 
# Trace multiple trace types at once.
279 
 
280 
test trace-5.1 {multiple ops traced at once} {
281 
    catch {unset x}
282 
    set info {}
283 
    trace var x rwu traceProc
284 
    catch {set x}
285 
    set x 22
286 
    set x
287 
    set x 33
288 
    unset x
289 
    set info
290 
} {x {} r x {} w x {} r x {} w x {} u}
291 
test trace-5.2 {multiple ops traced on array element} {
292 
    catch {unset x}
293 
    set info {}
294 
    trace var x(0) rwu traceProc
295 
    catch {set x(0)}
296 
    set x(0) 22
297 
    set x(0)
298 
    set x(0) 33
299 
    unset x(0)
300 
    unset x
301 
    set info
302 
} {x 0 r x 0 w x 0 r x 0 w x 0 u}
303 
test trace-5.3 {multiple ops traced on whole array} {
304 
    catch {unset x}
305 
    set info {}
306 
    trace var x rwu traceProc
307 
    catch {set x(0)}
308 
    set x(0) 22
309 
    set x(0)
310 
    set x(0) 33
311 
    unset x(0)
312 
    unset x
313 
    set info
314 
} {x 0 w x 0 r x 0 w x 0 u x {} u}
315 
 
316 
# Check order of invocation of traces
317 
 
318 
test trace-6.1 {order of invocation of traces} {
319 
    catch {unset x}
320 
    set info {}
321 
    trace var x r "traceTag 1"
322 
    trace var x r "traceTag 2"
323 
    trace var x r "traceTag 3"
324 
    catch {set x}
325 
    set x 22
326 
    set x
327 
    set info
328 
} {3 2 1 3 2 1}
329 
test trace-6.2 {order of invocation of traces} {
330 
    catch {unset x}
331 
    set x(0) 44
332 
    set info {}
333 
    trace var x(0) r "traceTag 1"
334 
    trace var x(0) r "traceTag 2"
335 
    trace var x(0) r "traceTag 3"
336 
    set x(0)
337 
    set info
338 
} {3 2 1}
339 
test trace-6.3 {order of invocation of traces} {
340 
    catch {unset x}
341 
    set x(0) 44
342 
    set info {}
343 
    trace var x(0) r "traceTag 1"
344 
    trace var x r "traceTag A1"
345 
    trace var x(0) r "traceTag 2"
346 
    trace var x r "traceTag A2"
347 
    trace var x(0) r "traceTag 3"
348 
    trace var x r "traceTag A3"
349 
    set x(0)
350 
    set info
351 
} {A3 A2 A1 3 2 1}
352 
 
353 
# Check effects of errors in trace procedures
354 
 
355 
test trace-7.1 {error returns from traces} {
356 
    catch {unset x}
357 
    set x 123
358 
    set info {}
359 
    trace var x r "traceTag 1"
360 
    trace var x r traceError
361 
    list [catch {set x} msg] $msg $info
362 
} {1 {can't read "x": trace returned error} {}}
363 
test trace-7.2 {error returns from traces} {
364 
    catch {unset x}
365 
    set x 123
366 
    set info {}
367 
    trace var x w "traceTag 1"
368 
    trace var x w traceError
369 
    list [catch {set x 44} msg] $msg $info
370 
} {1 {can't set "x": trace returned error} {}}
371 
test trace-7.3 {error returns from traces} {
372 
    catch {unset x}
373 
    set x 123
374 
    set info {}
375 
    trace var x w traceError
376 
    list [catch {append x 44} msg] $msg $info
377 
} {1 {can't set "x": trace returned error} {}}
378 
test trace-7.4 {error returns from traces} {
379 
    catch {unset x}
380 
    set x 123
381 
    set info {}
382 
    trace var x u "traceTag 1"
383 
    trace var x u traceError
384 
    list [catch {unset x} msg] $msg $info
385 
} {0 {} 1}
386 
test trace-7.5 {error returns from traces} {
387 
    catch {unset x}
388 
    set x(0) 123
389 
    set info {}
390 
    trace var x(0) r "traceTag 1"
391 
    trace var x r "traceTag 2"
392 
    trace var x r traceError
393 
    trace var x r "traceTag 3"
394 
    list [catch {set x(0)} msg] $msg $info
395 
} {1 {can't read "x(0)": trace returned error} 3}
396 
test trace-7.6 {error returns from traces} {
397 
    catch {unset x}
398 
    set x 123
399 
    trace var x u traceError
400 
    list [catch {unset x} msg] $msg
401 
} {0 {}}
402 
test trace-7.7 {error returns from traces} {
403 
    # This test just makes sure that the memory for the error message
404 
    # gets deallocated correctly when the trace is invoked again or
405 
    # when the trace is deleted.
406 
    catch {unset x}
407 
    set x 123
408 
    trace var x r traceError
409 
    catch {set x}
410 
    catch {set x}
411 
    trace vdelete x r traceError
412 
} {}
413 
 
414 
# Check to see that variables are expunged before trace
415 
# procedures are invoked, so trace procedure can even manipulate
416 
# a new copy of the variables.
417 
 
418 
test trace-8.1 {be sure variable is unset before trace is called} {
419 
    catch {unset x}
420 
    set x 33
421 
    set info {}
422 
    trace var x u {traceCheck {uplevel set x}}
423 
    unset x
424 
    set info
425 
} {1 {can't read "x": no such variable}}
426 
test trace-8.2 {be sure variable is unset before trace is called} {
427 
    catch {unset x}
428 
    set x 33
429 
    set info {}
430 
    trace var x u {traceCheck {uplevel set x 22}}
431 
    unset x
432 
    concat $info [list [catch {set x} msg] $msg]
433 
} {0 22 0 22}
434 
test trace-8.3 {be sure traces are cleared before unset trace called} {
435 
    catch {unset x}
436 
    set x 33
437 
    set info {}
438 
    trace var x u {traceCheck {uplevel trace vinfo x}}
439 
    unset x
440 
    set info
441 
} {0 {}}
442 
test trace-8.4 {set new trace during unset trace} {
443 
    catch {unset x}
444 
    set x 33
445 
    set info {}
446 
    trace var x u {traceCheck {global x; trace var x u traceProc}}
447 
    unset x
448 
    concat $info [trace vinfo x]
449 
} {0 {} {u traceProc}}
450 
 
451 
test trace-9.1 {make sure array elements are unset before traces are called} {
452 
    catch {unset x}
453 
    set x(0) 33
454 
    set info {}
455 
    trace var x(0) u {traceCheck {uplevel set x(0)}}
456 
    unset x(0)
457 
    set info
458 
} {1 {can't read "x(0)": no such element in array}}
459 
test trace-9.2 {make sure array elements are unset before traces are called} {
460 
    catch {unset x}
461 
    set x(0) 33
462 
    set info {}
463 
    trace var x(0) u {traceCheck {uplevel set x(0) zzz}}
464 
    unset x(0)
465 
    concat $info [list [catch {set x(0)} msg] $msg]
466 
} {0 zzz 0 zzz}
467 
test trace-9.3 {array elements are unset before traces are called} {
468 
    catch {unset x}
469 
    set x(0) 33
470 
    set info {}
471 
    trace var x(0) u {traceCheck {global x; trace vinfo x(0)}}
472 
    unset x(0)
473 
    set info
474 
} {0 {}}
475 
test trace-9.4 {set new array element trace during unset trace} {
476 
    catch {unset x}
477 
    set x(0) 33
478 
    set info {}
479 
    trace var x(0) u {traceCheck {uplevel {trace variable x(0) r {}}}}
480 
    catch {unset x(0)}
481 
    concat $info [trace vinfo x(0)]
482 
} {0 {} {r {}}}
483 
 
484 
test trace-10.1 {make sure arrays are unset before traces are called} {
485 
    catch {unset x}
486 
    set x(0) 33
487 
    set info {}
488 
    trace var x u {traceCheck {uplevel set x(0)}}
489 
    unset x
490 
    set info
491 
} {1 {can't read "x(0)": no such variable}}
492 
test trace-10.2 {make sure arrays are unset before traces are called} {
493 
    catch {unset x}
494 
    set x(y) 33
495 
    set info {}
496 
    trace var x u {traceCheck {uplevel set x(y) 22}}
497 
    unset x
498 
    concat $info [list [catch {set x(y)} msg] $msg]
499 
} {0 22 0 22}
500 
test trace-10.3 {make sure arrays are unset before traces are called} {
501 
    catch {unset x}
502 
    set x(y) 33
503 
    set info {}
504 
    trace var x u {traceCheck {uplevel array exists x}}
505 
    unset x
506 
    set info
507 
} {0 0}
508 
test trace-10.4 {make sure arrays are unset before traces are called} {
509 
    catch {unset x}
510 
    set x(y) 33
511 
    set info {}
512 
    set cmd {traceCheck {uplevel {trace vinfo x}}}
513 
    trace var x u $cmd
514 
    unset x
515 
    set info
516 
} {0 {}}
517 
test trace-10.5 {set new array trace during unset trace} {
518 
    catch {unset x}
519 
    set x(y) 33
520 
    set info {}
521 
    trace var x u {traceCheck {global x; trace var x r {}}}
522 
    unset x
523 
    concat $info [trace vinfo x]
524 
} {0 {} {r {}}}
525 
test trace-10.6 {create scalar during array unset trace} {
526 
    catch {unset x}
527 
    set x(y) 33
528 
    set info {}
529 
    trace var x u {traceCheck {global x; set x 44}}
530 
    unset x
531 
    concat $info [list [catch {set x} msg] $msg]
532 
} {0 44 0 44}
533 
 
534 
# Check special conditions (e.g. errors) in Tcl_TraceVar2.
535 
 
536 
test trace-11.1 {creating array when setting variable traces} {
537 
    catch {unset x}
538 
    set info {}
539 
    trace var x(0) w traceProc
540 
    list [catch {set x 22} msg] $msg
541 
} {1 {can't set "x": variable is array}}
542 
test trace-11.2 {creating array when setting variable traces} {
543 
    catch {unset x}
544 
    set info {}
545 
    trace var x(0) w traceProc
546 
    list [catch {set x(0)} msg] $msg
547 
} {1 {can't read "x(0)": no such element in array}}
548 
test trace-11.3 {creating array when setting variable traces} {
549 
    catch {unset x}
550 
    set info {}
551 
    trace var x(0) w traceProc
552 
    set x(0) 22
553 
    set info
554 
} {x 0 w}
555 
test trace-11.4 {creating variable when setting variable traces} {
556 
    catch {unset x}
557 
    set info {}
558 
    trace var x w traceProc
559 
    list [catch {set x} msg] $msg
560 
} {1 {can't read "x": no such variable}}
561 
test trace-11.5 {creating variable when setting variable traces} {
562 
    catch {unset x}
563 
    set info {}
564 
    trace var x w traceProc
565 
    set x 22
566 
    set info
567 
} {x {} w}
568 
test trace-11.6 {creating variable when setting variable traces} {
569 
    catch {unset x}
570 
    set info {}
571 
    trace var x w traceProc
572 
    set x(0) 22
573 
    set info
574 
} {x 0 w}
575 
test trace-11.7 {create array element during read trace} {
576 
    catch {unset x}
577 
    set x(2) zzz
578 
    trace var x r {traceCrtElement xyzzy}
579 
    list [catch {set x(3)} msg] $msg
580 
} {0 xyzzy}
581 
test trace-11.8 {errors when setting variable traces} {
582 
    catch {unset x}
583 
    set x 44
584 
    list [catch {trace var x(0) w traceProc} msg] $msg
585 
} {1 {can't trace "x(0)": variable isn't array}}
586 
 
587 
# Check deleting one trace from another.
588 
 
589 
test trace-12.1 {delete one trace from another} {
590 
    proc delTraces {args} {
591 
        global x
592 
        trace vdel x r {traceTag 2}
593 
        trace vdel x r {traceTag 3}
594 
        trace vdel x r {traceTag 4}
595 
    }
596 
    catch {unset x}
597 
    set x 44
598 
    set info {}
599 
    trace var x r {traceTag 1}
600 
    trace var x r {traceTag 2}
601 
    trace var x r {traceTag 3}
602 
    trace var x r {traceTag 4}
603 
    trace var x r delTraces
604 
    trace var x r {traceTag 5}
605 
    set x
606 
    set info
607 
} {5 1}
608 
 
609 
# Check operation and syntax of "trace" command.
610 
 
611 
test trace-13.1 {trace command (overall)} {
612 
    list [catch {trace} msg] $msg
613 
} {1 {too few args: should be "trace option [arg arg ...]"}}
614 
test trace-13.2 {trace command (overall)} {
615 
    list [catch {trace gorp} msg] $msg
616 
} {1 {bad option "gorp": should be variable, vdelete, or vinfo}}
617 
test trace-13.3 {trace command ("variable" option)} {
618 
    list [catch {trace variable x y} msg] $msg
619 
} {1 {wrong # args: should be "trace variable name ops command"}}
620 
test trace-13.4 {trace command ("variable" option)} {
621 
    list [catch {trace var x y z z2} msg] $msg
622 
} {1 {wrong # args: should be "trace variable name ops command"}}
623 
test trace-13.5 {trace command ("variable" option)} {
624 
    list [catch {trace var x y z} msg] $msg
625 
} {1 {bad operations "y": should be one or more of rwu}}
626 
test trace-13.6 {trace command ("vdelete" option)} {
627 
    list [catch {trace vdelete x y} msg] $msg
628 
} {1 {wrong # args: should be "trace vdelete name ops command"}}
629 
test trace-13.7 {trace command ("vdelete" option)} {
630 
    list [catch {trace vdelete x y z foo} msg] $msg
631 
} {1 {wrong # args: should be "trace vdelete name ops command"}}
632 
test trace-13.8 {trace command ("vdelete" option)} {
633 
    list [catch {trace vdelete x y z} msg] $msg
634 
} {1 {bad operations "y": should be one or more of rwu}}
635 
test trace-13.9 {trace command ("vdelete" option)} {
636 
    catch {unset x}
637 
    set info {}
638 
    trace var x w traceProc
639 
    trace vdelete x w traceProc
640 
} {}
641 
test trace-13.10 {trace command ("vdelete" option)} {
642 
    catch {unset x}
643 
    set info {}
644 
    trace var x w traceProc
645 
    trace vdelete x w traceProc
646 
    set x 12345
647 
    set info
648 
} {}
649 
test trace-13.11 {trace command ("vdelete" option)} {
650 
    catch {unset x}
651 
    set info {}
652 
    trace var x w {traceTag 1}
653 
    trace var x w traceProc
654 
    trace var x w {traceTag 2}
655 
    set x yy
656 
    trace vdelete x w traceProc
657 
    set x 12345
658 
    trace vdelete x w {traceTag 1}
659 
    set x foo
660 
    trace vdelete x w {traceTag 2}
661 
    set x gorp
662 
    set info
663 
} {2 x {} w 1 2 1 2}
664 
test trace-13.12 {trace command ("vdelete" option)} {
665 
    catch {unset x}
666 
    set info {}
667 
    trace var x w {traceTag 1}
668 
    trace vdelete x w non_existent
669 
    set x 12345
670 
    set info
671 
} {1}
672 
test trace-13.13 {trace command ("vinfo" option)} {
673 
    list [catch {trace vinfo} msg] $msg]
674 
} {1 {wrong # args: should be "trace vinfo name"]}}
675 
test trace-13.14 {trace command ("vinfo" option)} {
676 
    list [catch {trace vinfo x y} msg] $msg]
677 
} {1 {wrong # args: should be "trace vinfo name"]}}
678 
test trace-13.15 {trace command ("vinfo" option)} {
679 
    catch {unset x}
680 
    trace var x w {traceTag 1}
681 
    trace var x w traceProc
682 
    trace var x w {traceTag 2}
683 
    trace vinfo x
684 
} {{w {traceTag 2}} {w traceProc} {w {traceTag 1}}}
685 
test trace-13.16 {trace command ("vinfo" option)} {
686 
    catch {unset x}
687 
    trace vinfo x
688 
} {}
689 
test trace-13.17 {trace command ("vinfo" option)} {
690 
    catch {unset x}
691 
    trace vinfo x(0)
692 
} {}
693 
test trace-13.18 {trace command ("vinfo" option)} {
694 
    catch {unset x}
695 
    set x 44
696 
    trace vinfo x(0)
697 
} {}
698 
test trace-13.19 {trace command ("vinfo" option)} {
699 
    catch {unset x}
700 
    set x 44
701 
    trace var x w {traceTag 1}
702 
    proc check {} {global x; trace vinfo x}
703 
    check
704 
} {{w {traceTag 1}}}
705 
 
706 
# Check fancy trace commands (long ones, weird arguments, etc.)
707 
 
708 
test trace-14.1 {long trace command} {
709 
    catch {unset x}
710 
    set info {}
711 
    trace var x w {traceTag {This is a very very long argument.  It's \
712 
        designed to test out the facilities of TraceVarProc for dealing \
713 
        with such long arguments by malloc-ing space.  One possibility \
714 
        is that space doesn't get freed properly.  If this happens, then \
715 
        invoking this test over and over again will eventually leak memory.}}
716 
    set x 44
717 
    set info
718 
} {This is a very very long argument.  It's \
719 
        designed to test out the facilities of TraceVarProc for dealing \
720 
        with such long arguments by malloc-ing space.  One possibility \
721 
        is that space doesn't get freed properly.  If this happens, then \
722 
        invoking this test over and over again will eventually leak memory.}
723 
test trace-14.2 {long trace command result to ignore} {
724 
    proc longResult {args} {return "quite a bit of text, designed to
725 
        generate a core leak if this command file is invoked over and over again
726 
        and memory isn't being recycled correctly"}
727 
    catch {unset x}
728 
    trace var x w longResult
729 
    set x 44
730 
    set x 5
731 
    set x abcde
732 
} abcde
733 
test trace-14.3 {special list-handling in trace commands} {
734 
    catch {unset "x y z"}
735 
    set "x y z(a\n\{)" 44
736 
    set info {}
737 
    trace var "x y z(a\n\{)" w traceProc
738 
    set "x y z(a\n\{)" 33
739 
    set info
740 
} "{x y z} a\\n\\{ w"
741 
 
742 
# Check for proper handling of unsets during traces.
743 
 
744 
proc traceUnset {unsetName args} {
745 
    global info
746 
    upvar $unsetName x
747 
    lappend info [catch {unset x} msg] $msg [catch {set x} msg] $msg
748 
}
749 
proc traceReset {unsetName resetName args} {
750 
    global info
751 
    upvar $unsetName x $resetName y
752 
    lappend info [catch {unset x} msg] $msg [catch {set y xyzzy} msg] $msg
753 
}
754 
proc traceReset2 {unsetName resetName args} {
755 
    global info
756 
    lappend info [catch {uplevel unset $unsetName} msg] $msg \
757 
            [catch {uplevel set $resetName xyzzy} msg] $msg
758 
}
759 
proc traceAppend {string name1 name2 op} {
760 
    global info
761 
    lappend info $string
762 
}
763 
 
764 
test trace-15.1 {unsets during read traces} {
765 
    catch {unset y}
766 
    set y 1234
767 
    set info {}
768 
    trace var y r {traceUnset y}
769 
    trace var y u {traceAppend unset}
770 
    lappend info [catch {set y} msg] $msg
771 
} {unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
772 
test trace-15.2 {unsets during read traces} {
773 
    catch {unset y}
774 
    set y(0) 1234
775 
    set info {}
776 
    trace var y(0) r {traceUnset y(0)}
777 
    lappend info [catch {set y(0)} msg] $msg
778 
} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such element in array}}
779 
test trace-15.3 {unsets during read traces} {
780 
    catch {unset y}
781 
    set y(0) 1234
782 
    set info {}
783 
    trace var y(0) r {traceUnset y}
784 
    lappend info [catch {set y(0)} msg] $msg
785 
} {0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
786 
test trace-15.4 {unsets during read traces} {
787 
    catch {unset y}
788 
    set y 1234
789 
    set info {}
790 
    trace var y r {traceReset y y}
791 
    lappend info [catch {set y} msg] $msg
792 
} {0 {} 0 xyzzy 0 xyzzy}
793 
test trace-15.5 {unsets during read traces} {
794 
    catch {unset y}
795 
    set y(0) 1234
796 
    set info {}
797 
    trace var y(0) r {traceReset y(0) y(0)}
798 
    lappend info [catch {set y(0)} msg] $msg
799 
} {0 {} 0 xyzzy 0 xyzzy}
800 
test trace-15.6 {unsets during read traces} {
801 
    catch {unset y}
802 
    set y(0) 1234
803 
    set info {}
804 
    trace var y(0) r {traceReset y y(0)}
805 
    lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
806 
} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 1 {can't read "y(0)": no such variable} 1 {can't read "y(0)": no such variable}}
807 
test trace-15.7 {unsets during read traces} {
808 
    catch {unset y}
809 
    set y(0) 1234
810 
    set info {}
811 
    trace var y(0) r {traceReset2 y y(0)}
812 
    lappend info [catch {set y(0)} msg] $msg [catch {set y(0)} msg] $msg
813 
} {0 {} 0 xyzzy 1 {can't read "y(0)": no such element in array} 0 xyzzy}
814 
test trace-15.8 {unsets during write traces} {
815 
    catch {unset y}
816 
    set y 1234
817 
    set info {}
818 
    trace var y w {traceUnset y}
819 
    trace var y u {traceAppend unset}
820 
    lappend info [catch {set y xxx} msg] $msg
821 
} {unset 0 {} 1 {can't read "x": no such variable} 0 {}}
822 
test trace-15.9 {unsets during write traces} {
823 
    catch {unset y}
824 
    set y(0) 1234
825 
    set info {}
826 
    trace var y(0) w {traceUnset y(0)}
827 
    lappend info [catch {set y(0) xxx} msg] $msg
828 
} {0 {} 1 {can't read "x": no such variable} 0 {}}
829 
test trace-15.10 {unsets during write traces} {
830 
    catch {unset y}
831 
    set y(0) 1234
832 
    set info {}
833 
    trace var y(0) w {traceUnset y}
834 
    lappend info [catch {set y(0) xxx} msg] $msg
835 
} {0 {} 1 {can't read "x": no such variable} 0 {}}
836 
test trace-15.11 {unsets during write traces} {
837 
    catch {unset y}
838 
    set y 1234
839 
    set info {}
840 
    trace var y w {traceReset y y}
841 
    lappend info [catch {set y xxx} msg] $msg
842 
} {0 {} 0 xyzzy 0 xyzzy}
843 
test trace-15.12 {unsets during write traces} {
844 
    catch {unset y}
845 
    set y(0) 1234
846 
    set info {}
847 
    trace var y(0) w {traceReset y(0) y(0)}
848 
    lappend info [catch {set y(0) xxx} msg] $msg
849 
} {0 {} 0 xyzzy 0 xyzzy}
850 
test trace-15.13 {unsets during write traces} {
851 
    catch {unset y}
852 
    set y(0) 1234
853 
    set info {}
854 
    trace var y(0) w {traceReset y y(0)}
855 
    lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
856 
} {0 {} 1 {can't set "y": upvar refers to element in deleted array} 0 {} 1 {can't read "y(0)": no such variable}}
857 
test trace-15.14 {unsets during write traces} {
858 
    catch {unset y}
859 
    set y(0) 1234
860 
    set info {}
861 
    trace var y(0) w {traceReset2 y y(0)}
862 
    lappend info [catch {set y(0) xxx} msg] $msg [catch {set y(0)} msg] $msg
863 
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
864 
test trace-15.15 {unsets during unset traces} {
865 
    catch {unset y}
866 
    set y 1234
867 
    set info {}
868 
    trace var y u {traceUnset y}
869 
    lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
870 
} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y": no such variable}}
871 
test trace-15.16 {unsets during unset traces} {
872 
    catch {unset y}
873 
    set y(0) 1234
874 
    set info {}
875 
    trace var y(0) u {traceUnset y(0)}
876 
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
877 
} {1 {can't unset "x": no such variable} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such element in array}}
878 
test trace-15.17 {unsets during unset traces} {
879 
    catch {unset y}
880 
    set y(0) 1234
881 
    set info {}
882 
    trace var y(0) u {traceUnset y}
883 
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
884 
} {0 {} 1 {can't read "x": no such variable} 0 {} 1 {can't read "y(0)": no such variable}}
885 
test trace-15.18 {unsets during unset traces} {
886 
    catch {unset y}
887 
    set y 1234
888 
    set info {}
889 
    trace var y u {traceReset2 y y}
890 
    lappend info [catch {unset y} msg] $msg [catch {set y} msg] $msg
891 
} {1 {can't unset "y": no such variable} 0 xyzzy 0 {} 0 xyzzy}
892 
test trace-15.19 {unsets during unset traces} {
893 
    catch {unset y}
894 
    set y(0) 1234
895 
    set info {}
896 
    trace var y(0) u {traceReset2 y(0) y(0)}
897 
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
898 
} {1 {can't unset "y(0)": no such element in array} 0 xyzzy 0 {} 0 xyzzy}
899 
test trace-15.20 {unsets during unset traces} {
900 
    catch {unset y}
901 
    set y(0) 1234
902 
    set info {}
903 
    trace var y(0) u {traceReset2 y y(0)}
904 
    lappend info [catch {unset y(0)} msg] $msg [catch {set y(0)} msg] $msg
905 
} {0 {} 0 xyzzy 0 {} 0 xyzzy}
906 
test trace-15.21 {unsets cancelling traces} {
907 
    catch {unset y}
908 
    set y 1234
909 
    set info {}
910 
    trace var y r {traceAppend first}
911 
    trace var y r {traceUnset y}
912 
    trace var y r {traceAppend third}
913 
    trace var y u {traceAppend unset}
914 
    lappend info [catch {set y} msg] $msg
915 
} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y": no such variable}}
916 
test trace-15.22 {unsets cancelling traces} {
917 
    catch {unset y}
918 
    set y(0) 1234
919 
    set info {}
920 
    trace var y(0) r {traceAppend first}
921 
    trace var y(0) r {traceUnset y}
922 
    trace var y(0) r {traceAppend third}
923 
    trace var y(0) u {traceAppend unset}
924 
    lappend info [catch {set y(0)} msg] $msg
925 
} {third unset 0 {} 1 {can't read "x": no such variable} 1 {can't read "y(0)": no such variable}}
926 
 
927 
# Check various non-interference between traces and other things.
928 
 
929 
test trace-16.1 {trace doesn't prevent unset errors} {
930 
    catch {unset x}
931 
    set info {}
932 
    trace var x u {traceProc}
933 
    list [catch {unset x} msg] $msg $info
934 
} {1 {can't unset "x": no such variable} {x {} u}}
935 
test trace-16.2 {traced variables must survive procedure exits} {
936 
    catch {unset x}
937 
    proc p1 {} {global x; trace var x w traceProc}
938 
    p1
939 
    trace vinfo x
940 
} {{w traceProc}}
941 
test trace-16.3 {traced variables must survive procedure exits} {
942 
    catch {unset x}
943 
    set info {}
944 
    proc p1 {} {global x; trace var x w traceProc}
945 
    p1
946 
    set x 44
947 
    set info
948 
} {x {} w}
949 
 
950 
# Be sure that procedure frames are released before unset traces
951 
# are invoked.
952 
 
953 
test trace-17.1 {unset traces on procedure returns} {
954 
    proc p1 {x y} {set a 44; p2 14}
955 
    proc p2 {z} {trace var z u {traceCheck {lsort [uplevel {info vars}]}}}
956 
    set info {}
957 
    p1 foo bar
958 
    set info
959 
} {0 {a x y}}
960 
 
961 
# Delete arrays when done, so they can be re-used as scalars
962 
# elsewhere.
963 
 
964 
catch {unset x}
965 
catch {unset y}
966 
concat {}

powered by: WebSVN 2.1.0

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