summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorericm <ericm>2000-08-25 20:39:31 (GMT)
committerericm <ericm>2000-08-25 20:39:31 (GMT)
commitf97152e392c85c9bd4b78be2bb666328b7044928 (patch)
treec69a36203d04a0e5c5ed4330b83a25a757695724
parentda5194713b3c8a85943b8b731534a32a398981a9 (diff)
downloadtcl-f97152e392c85c9bd4b78be2bb666328b7044928.zip
tcl-f97152e392c85c9bd4b78be2bb666328b7044928.tar.gz
tcl-f97152e392c85c9bd4b78be2bb666328b7044928.tar.bz2
* 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.
-rw-r--r--ChangeLog12
-rw-r--r--doc/trace.n7
-rw-r--r--generic/tclVar.c5
-rw-r--r--tests/trace.test35
4 files changed, 47 insertions, 12 deletions
diff --git a/ChangeLog b/ChangeLog
index 6e55953..82275d6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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} {