diff options
| -rw-r--r-- | ChangeLog | 12 | ||||
| -rw-r--r-- | doc/trace.n | 7 | ||||
| -rw-r--r-- | generic/tclVar.c | 5 | ||||
| -rw-r--r-- | tests/trace.test | 35 |
4 files changed, 47 insertions, 12 deletions
@@ -1,3 +1,15 @@ +2000-08-25 Eric Melski <ericm@ajubasolutions.com> + + * tests/trace.test: Extended array tracing tests. + + * doc/trace.n: Clarified information about when array traces will + be fired. + + * generic/tclVar.c (Tcl_ArrayObjCmd): Corrected call to CallTraces + (for TCL_TRACE_ARRAY) to only be called when the variable is + either an array or is undefined, to ensure that array traces do + not fire for scalar variables. + 2000-08-24 Eric Melski <ericm@ajubasolutions.com> * doc/man.macros: Tweaked tab settings for .SO (Standard Options) diff --git a/doc/trace.n b/doc/trace.n index bf04299..e351311 100644 --- a/doc/trace.n +++ b/doc/trace.n @@ -5,7 +5,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.n,v 1.4 2000/08/25 02:04:27 ericm Exp $ +'\" RCS: @(#) $Id: trace.n,v 1.5 2000/08/25 20:39:31 ericm Exp $ '\" .so man.macros .TH trace n "8.4" Tcl "Tcl Built-In Commands" @@ -83,7 +83,10 @@ one or more of the following items: .TP \fBarray\fR Invoke \fIcommand\fR whenever the variable is accessed or modified via -the \fBarray\fR command. +the \fBarray\fR command, provided that \fIname\fR is not a scalar +variable at the time that the \fBarray\fR command is invoked. If +\fIname\fR is a scalar variable, the access via the \fBarray\fR +command will not trigger the trace. \fBread\fR Invoke \fIcommand\fR whenever the variable is read. .TP diff --git a/generic/tclVar.c b/generic/tclVar.c index 48fd89a..b8a0271 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.22 2000/08/25 02:04:29 ericm Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.23 2000/08/25 20:39:31 ericm Exp $ */ #include "tclInt.h" @@ -2947,7 +2947,8 @@ Tcl_ArrayObjCmd(dummy, interp, objc, objv) * array names, array get, etc. */ - if (varPtr != NULL && varPtr->tracePtr != NULL) { + if (varPtr != NULL && varPtr->tracePtr != NULL + && (TclIsVarArray(varPtr) || TclIsVarUndefined(varPtr))) { msg = CallTraces(iPtr, arrayPtr, varPtr, varName, NULL, (TCL_LEAVE_ERR_MSG|TCL_NAMESPACE_ONLY|TCL_GLOBAL_ONLY| TCL_TRACE_ARRAY)); diff --git a/tests/trace.test b/tests/trace.test index 11da1a9..66ec08f 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.8 2000/08/25 02:04:29 ericm Exp $ +# RCS: @(#) $Id: trace.test,v 1.9 2000/08/25 20:39:32 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -285,39 +285,58 @@ test trace-4.9 {trace unsets on whole arrays} { # Array tracing on variables test trace-5.1 {array traces fire on accesses via [array]} { catch {unset x} + set x(b) 2 trace add variable x array traceArray2 set ::info {} array set x {a 1} - set info + set ::info } {x {} array} test trace-5.2 {array traces do not fire on normal accesses} { catch {unset x} + set x(b) 2 trace add variable x array traceArray2 set ::info {} set x(a) 1 set x(b) $x(a) - set info + set ::info } {} -test trace-5.3 {array traces outlive variable} { +test trace-5.3 {array traces do not outlive variable} { catch {unset x} trace add variable x array traceArray2 set ::info {} set x(a) 1 unset x array set x {a 1} - set info + set ::info } {} test trace-5.4 {array traces properly listed in trace information} { catch {unset x} trace add variable x array traceArray2 - trace list variable x + set result [trace list variable x] + set result } [list [list array traceArray2]] test trace-5.5 {array traces properly listed in trace information} { catch {unset x} trace variable x a traceArray2 - trace vinfo x + set result [trace vinfo x] + set result } [list [list a traceArray2]] - +test trace-5.6 {array traces don't fire on scalar variables} { + catch {unset x} + set x foo + trace add variable x array traceArray2 + set ::info {} + catch {array set x {a 1}} + set ::info +} {} +test trace-5.7 {array traces fire for undefined variables} { + catch {unset x} + trace add variable x array traceArray2 + set ::info {} + array set x {a 1} + set ::info +} {x {} array} + # Trace multiple trace types at once. test trace-5.1 {multiple ops traced at once} { |