From f97152e392c85c9bd4b78be2bb666328b7044928 Mon Sep 17 00:00:00 2001
From: ericm <ericm>
Date: Fri, 25 Aug 2000 20:39:31 +0000
Subject: * 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.
---
 ChangeLog        | 12 ++++++++++++
 doc/trace.n      |  7 +++++--
 generic/tclVar.c |  5 +++--
 tests/trace.test | 35 +++++++++++++++++++++++++++--------
 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} {
-- 
cgit v0.12