home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tcl7.4 / tests / trace.test < prev    next >
Encoding:
Text File  |  1994-12-18  |  27.2 KB  |  931 lines

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