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

Subversion Repositories or1k

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

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.