diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2002-06-13 19:47:57 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2002-06-13 19:47:57 (GMT) |
commit | b2df30e5adb45bbbbdd44e958348149397eaa2d0 (patch) | |
tree | 8cfdc93aae1c6480fa1294c2d765c12c2e2a5e3c /generic/tclVar.c | |
parent | bb8e30079bb427d90dc44175fea4fe66ccc9d4d7 (diff) | |
download | tcl-b2df30e5adb45bbbbdd44e958348149397eaa2d0.zip tcl-b2df30e5adb45bbbbdd44e958348149397eaa2d0.tar.gz tcl-b2df30e5adb45bbbbdd44e958348149397eaa2d0.tar.bz2 |
consolidated opcodes in the bytecode engine, eliminating duplicated
code. Added the new (but pre-existent in tcl.h) possible flag bit
TCL_TRACE_READS to Tcl_(Obj)?SetVar.*
Diffstat (limited to 'generic/tclVar.c')
-rw-r--r-- | generic/tclVar.c | 30 |
1 files changed, 17 insertions, 13 deletions
diff --git a/generic/tclVar.c b/generic/tclVar.c index 6857a9f..133b387 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -15,7 +15,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.51 2002/03/29 00:02:42 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.52 2002/06/13 19:47:58 msofer Exp $ */ #include "tclInt.h" @@ -1243,12 +1243,18 @@ Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) } /* - * At this point, if we were appending, we used to call read traces: we - * treated append as a read-modify-write. However, it seemed unlikely to - * us that a real program would be interested in such reads being done - * during a set operation. + * Invoke any read traces that have been set for the variable if it + * is requested; this is only done in the core when lappending. */ + if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) + || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { + if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, part1, part2, + TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { + return NULL; + } + } + /* * Set the variable's new value. If appending, append the new value to * the variable, either as a list element or as a string. Also, if @@ -1448,12 +1454,11 @@ TclSetIndexedScalar(interp, localIndex, newValuePtr, flags) } /* - * Invoke any read traces that have been set for the variable if we - * are appending, but only in the lappend case. + * Invoke any read traces that have been set for the variable if it + * is requested; this is only done in the core when lappending. */ - if ((flags & TCL_APPEND_VALUE) && (flags & TCL_LIST_ELEMENT) - && (varPtr->tracePtr != NULL)) { + if ((flags & TCL_TRACE_READS) && (varPtr->tracePtr != NULL)) { if (TCL_ERROR == CallTraces(iPtr, /*arrayPtr*/ NULL, varPtr, varName, NULL, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { return NULL; @@ -1749,12 +1754,11 @@ TclSetElementOfIndexedArray(interp, localIndex, elemPtr, newValuePtr, flags) } /* - * Invoke any read traces that have been set for the element variable if - * we are appending, but only in the lappend case. + * Invoke any read traces that have been set for the variable if it + * is requested; this is only done in the core when lappending. */ - if ((flags & TCL_APPEND_VALUE) && (flags & TCL_LIST_ELEMENT) - && ((varPtr->tracePtr != NULL) + if ((flags & TCL_TRACE_READS) && ((varPtr->tracePtr != NULL) || ((arrayPtr != NULL) && (arrayPtr->tracePtr != NULL)))) { if (TCL_ERROR == CallTraces(iPtr, arrayPtr, varPtr, arrayName, elem, TCL_TRACE_READS, (flags & TCL_LEAVE_ERR_MSG))) { |