diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/stringObj.test | 4 | ||||
| -rw-r--r-- | tests/trace.test | 129 |
2 files changed, 101 insertions, 32 deletions
diff --git a/tests/stringObj.test b/tests/stringObj.test index c2db812..b27557d 100644 --- a/tests/stringObj.test +++ b/tests/stringObj.test @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: stringObj.test,v 1.12 2002/11/13 22:11:41 vincentdarley Exp $ +# RCS: @(#) $Id: stringObj.test,v 1.13 2003/01/17 14:19:54 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -415,7 +415,7 @@ test stringObj-13.6 {Tcl_GetCharLength with mixed width chars} { list [string length $a] [string length $a] } {10 10} -test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} {knownBug} { +test stringObj-14.1 {Tcl_SetObjLength on pure unicode object} { teststringobj set 1 foo teststringobj getunicode 1 teststringobj append 1 bar -1 diff --git a/tests/trace.test b/tests/trace.test index 2e8b61b..52a6c4e 100644 --- a/tests/trace.test +++ b/tests/trace.test @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: trace.test,v 1.24 2002/11/13 22:11:41 vincentdarley Exp $ +# RCS: @(#) $Id: trace.test,v 1.25 2003/01/17 14:19:55 vincentdarley Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -865,27 +865,27 @@ test trace-14.12 {trace command ("remove variable" option)} { set x 12345 set info } {1} -test trace-14.15 {trace command ("list variable" option)} { +test trace-14.15 {trace command ("info variable" option)} { catch {unset x} trace add variable x write {traceTag 1} trace add variable x write traceProc trace add variable x write {traceTag 2} trace info variable x } {{write {traceTag 2}} {write traceProc} {write {traceTag 1}}} -test trace-14.16 {trace command ("list variable" option)} { +test trace-14.16 {trace command ("info variable" option)} { catch {unset x} trace info variable x } {} -test trace-14.17 {trace command ("list variable" option)} { +test trace-14.17 {trace command ("info variable" option)} { catch {unset x} trace info variable x(0) } {} -test trace-14.18 {trace command ("list variable" option)} { +test trace-14.18 {trace command ("info variable" option)} { catch {unset x} set x 44 trace info variable x(0) } {} -test trace-14.19 {trace command ("list variable" option)} { +test trace-14.19 {trace command ("info variable" option)} { catch {unset x} set x 44 trace add variable x write {traceTag 1} @@ -1604,36 +1604,36 @@ test trace-24.1 {delete trace during enter trace} { set info {} trace add execution foo enter [list traceDelete foo] foo 1 - list $info [trace info execution foo] -} {{{foo 1} enter} {}} + list $info [catch {trace info execution foo} res] $res +} {{{foo 1} enter} 0 {}} test trace-24.2 {delete trace during leave trace} { set info {} trace add execution foo leave [list traceDelete foo] foo 1 - list $info [trace info execution foo] -} {{{foo 1} 0 1 leave} {}} + list $info [catch {trace info execution foo} res] $res +} {{{foo 1} 0 1 leave} 0 {}} test trace-24.3 {delete trace during enter-leave trace} { set info {} trace add execution foo {enter leave} [list traceDelete foo] foo 1 - list $info [trace info execution foo] -} {{{foo 1} enter} {}} + list $info [catch {trace info execution foo} res] $res +} {{{foo 1} enter} 0 {}} test trace-24.4 {delete trace during all exec traces} { set info {} trace add execution foo {enter leave enterstep leavestep} [list traceDelete foo] foo 1 - list $info [trace info execution foo] -} {{{foo 1} enter} {}} + list $info [catch {trace info execution foo} res] $res +} {{{foo 1} enter} 0 {}} test trace-24.5 {delete trace during all exec traces except enter} { set info {} trace add execution foo {leave enterstep leavestep} [list traceDelete foo] foo 1 - list $info [trace info execution foo] -} {{{set b 1} enterstep} {}} + list $info [catch {trace info execution foo} res] $res +} {{{set b 1} enterstep} 0 {}} proc traceDelete {cmd args} { rename $cmd {} @@ -1649,8 +1649,8 @@ test trace-25.1 {delete command during enter trace} { set info {} trace add execution foo enter [list traceDelete foo] catch {foo 1} err - list $err $info [trace info execution foo] -} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}} + list $err $info [catch {trace info execution foo} res] $res +} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a @@ -1660,8 +1660,8 @@ test trace-25.2 {delete command during leave trace} { set info {} trace add execution foo leave [list traceDelete foo] foo 1 - list $info [trace info execution foo] -} {{{foo 1} 0 1 leave} {unknown command "foo"}} + list $info [catch {trace info execution foo} res] $res +} {{{foo 1} 0 1 leave} 1 {unknown command "foo"}} proc foo {a} { set b $a @@ -1672,8 +1672,8 @@ test trace-25.3 {delete command during enter then leave trace} { trace add execution foo enter [list traceDelete foo] trace add execution foo leave [list traceDelete foo] catch {foo 1} err - list $err $info [trace info execution foo] -} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}} + list $err $info [catch {trace info execution foo} res] $res +} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a @@ -1765,8 +1765,8 @@ test trace-25.8 {delete command during enter leave and enter/leave-step traces} trace add execution foo enterstep [list traceDelete foo] trace add execution foo leavestep [list traceDelete foo] catch {foo 1} err - list $err $info [trace info execution foo] -} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}} + list $err $info [catch {trace info execution foo} res] $res +} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a @@ -1778,8 +1778,8 @@ test trace-25.9 {delete command during enter leave and leavestep traces} { trace add execution foo leave [list traceDelete foo] trace add execution foo leavestep [list traceDelete foo] catch {foo 1} err - list $err $info [trace info execution foo] -} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}} + list $err $info [catch {trace info execution foo} res] $res +} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} proc foo {a} { set b $a @@ -1790,8 +1790,8 @@ test trace-25.10 {delete command during leave and leavestep traces} { trace add execution foo leave [list traceDelete foo] trace add execution foo leavestep [list traceDelete foo] catch {foo 1} err - list $err $info [trace info execution foo] -} {1 {{set b 1} 0 1 leavestep} {unknown command "foo"}} + list $err $info [catch {trace info execution foo} res] $res +} {1 {{set b 1} 0 1 leavestep} 1 {unknown command "foo"}} proc foo {a} { set b $a @@ -1802,8 +1802,8 @@ test trace-25.11 {delete command during enter and enterstep traces} { trace add execution foo enter [list traceDelete foo] trace add execution foo enterstep [list traceDelete foo] catch {foo 1} err - list $err $info [trace info execution foo] -} {{invalid command name "foo"} {{foo 1} enter} {unknown command "foo"}} + list $err $info [catch {trace info execution foo} res] $res +} {{invalid command name "foo"} {{foo 1} enter} 1 {unknown command "foo"}} test trace-26.1 {trace targetCmd when invoked through an alias} { proc foo {args} { @@ -1838,6 +1838,16 @@ test trace-27.1 {memory leak in rename trace (604609)} { info commands foo } {} +test trace-27.2 {command trace remove nonsense} { + list [catch {trace remove command thisdoesntexist \ + {delete rename} bar} res] $res +} {1 {unknown command "thisdoesntexist"}} + +test trace-27.3 {command trace info nonsense} { + list [catch {trace info command thisdoesntexist} res] $res +} {1 {unknown command "thisdoesntexist"}} + + test trace-28.1 {enterstep and leavestep traces with update idletasks (615043)} { catch {rename foo {}} proc foo {} { @@ -2019,6 +2029,65 @@ foo {if {[catch {bar}]} { }} 2 error leavestep foo foo 0 error leave}} +test trace-28.5 {exec traces} { + set info {} + proc foo {args} { set a 1 } + trace add execution foo {enter enterstep leave leavestep} \ + [list traceExecute foo] + after idle [list foo test-28.4] + update + # Complicated way of removing traces + set ti [lindex [eval [list trace info execution ::foo]] 0] + if {[llength $ti]} { + eval [concat [list trace remove execution foo] $ti] + } + join $info \n +} {foo {foo test-28.4} enter +foo {set a 1} enterstep +foo {set a 1} 0 1 leavestep +foo {foo test-28.4} 0 1 leave} + +test trace-28.6 {exec traces firing order} { + set info {} + proc enterStep {cmd op} {lappend ::info "enter $cmd/$op"} + proc leaveStep {cmd code result op} {lappend ::info "leave $cmd/$code/$result/$op"} + + proc foo x { + set b x=$x + incr x + } + trace add execution foo enterstep enterStep + trace add execution foo leavestep leaveStep + foo 42 + rename foo {} + join $info \n +} {enter set b x=42/enterstep +leave set b x=42/0/x=42/leavestep +enter incr x/enterstep +leave incr x/0/43/leavestep} + +test trace-28.7 {exec trace information} { + set info {} + proc foo x { incr x } + proc bar {args} {} + trace add execution foo {enter leave enterstep leavestep} bar + set info [trace info execution foo] + trace remove execution foo {enter leave enterstep leavestep} bar +} {} + +test trace-28.8 {exec trace remove nonsense} { + list [catch {trace remove execution thisdoesntexist \ + {enter leave enterstep leavestep} bar} res] $res +} {1 {unknown command "thisdoesntexist"}} + +test trace-28.9 {exec trace info nonsense} { + list [catch {trace info execution thisdoesntexist} res] $res +} {1 {unknown command "thisdoesntexist"}} + +test trace-28.10 {exec trace info nonsense} { + list [catch {trace remove execution} res] $res +} {1 {wrong # args: should be "trace remove execution name opList command"}} + # Delete procedures when done, so we don't clash with other tests # (e.g. foobar will clash with 'unknown' tests). catch {rename foobar {}} |