summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog245
-rw-r--r--generic/tclAssembly.c58
-rw-r--r--generic/tclAssembly.h10
-rw-r--r--generic/tclExecute.c25
-rw-r--r--generic/tclObj.c51
-rw-r--r--tests/assemble.test240
-rw-r--r--tests/dict.test8
7 files changed, 504 insertions, 133 deletions
diff --git a/ChangeLog b/ChangeLog
index 2ca7ca1..0d2f292 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,11 +1,26 @@
+2010-10-02 Kevin B. Kenny <kennykb@acm.org>
+
+ [dogeen-assembler-branch]
+
+ * generic/tclAssembly.c:
+ * generic/tclAssembly.h:
+ * tests/assemble.test: Added dictAppend, dictIncrImm, dictLappend,
+ dictSet, dictUnset, nsupvar, upvar, and variable. (Still need tests
+ for the last three.)
+
+2010-10-02 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TEBCresume): [Bug 3079830]: Added invalidation
+ of string representations of dictionaries in some cases.
+
2010-10-01 Jeff Hobbs <jeffh@ActiveState.com>
- * generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to
- return data to interp by default, or if given an arg, use that as
- filename to output to (accepts 'stdout' and 'stderr').
- Fix output to print used inst count data.
- * generic/tclCkalloc.c: change TclDumpMemoryInfo sig to allow
- * generic/tclInt.decls: objPtr as well as FILE* as output.
+ * generic/tclExecute.c (EvalStatsCmd): change 'evalstats' to return
+ data to interp by default, or if given an arg, use that as filename to
+ output to (accepts 'stdout' and 'stderr'). Fix output to print used
+ inst count data.
+ * generic/tclCkalloc.c: Change TclDumpMemoryInfo sig to allow objPtr
+ * generic/tclInt.decls: as well as FILE* as output.
* generic/tclIntDecls.h:
2010-10-01 Donal K. Fellows <dkf@users.sf.net>
@@ -44,39 +59,38 @@
2010-09-29 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/configure: re-generate with autoconf-2.59
+ * unix/configure: Re-generate with autoconf-2.59
* win/configure:
- * generic/tclMain.c make compilable with -DUNICODE as well
+ * generic/tclMain.c: Make compilable with -DUNICODE as well
2010-09-28 Reinhard Max <max@suse.de>
- Implementation of TIP #162, "IPv6 Sockets for Tcl"
+ TIP #162 IMPLEMENTATION
- * doc/socket.n: Document the changes to the [socket] and
- [fconfigure] commands.
+ * doc/socket.n: Document the changes to the [socket] and
+ [fconfigure] commands.
- * generic/tclInt.h: Introduce TclCreateSocketAddress() as a
- * generic/tclIOSock.c: replacement for the platform-dependent
- * unix/tclUnixSock.c: TclpCreateSocketAddress() functions.
- * unix/tclUnixChan.c: Extend the [socket] and [fconfigure]
- * unix/tclUnixPort.h: commands to behave as proposed in
- * win/tclWinSock.c: TIP #162.
- * win/tclWinPort.h:
+ * generic/tclInt.h: Introduce TclCreateSocketAddress() as a
+ * generic/tclIOSock.c: replacement for the platform-dependent
+ * unix/tclUnixSock.c: TclpCreateSocketAddress() functions. Extend
+ * unix/tclUnixChan.c: the [socket] and [fconfigure] commands to
+ * unix/tclUnixPort.h: behave as proposed in TIP #162. This is the
+ * win/tclWinSock.c: core of what is required to support the use of
+ * win/tclWinPort.h: IPv6 sockets in Tcl.
- * compat/fake-rfc2553.c: A compat implementation of the APIs
- * compat/fake-rfc2553.h: defined in RFC-2553 (getaddrinfo() and
- friends) on top of the existing
- gethostbyname() etc.
+ * compat/fake-rfc2553.c: A compat implementation of the APIs defined
+ * compat/fake-rfc2553.h: in RFC-2553 (getaddrinfo() and friends) on
+ top of the existing gethostbyname() etc.
* unix/configure.in: Test whether the fake-implementation is
* unix/tcl.m4: needed.
* unix/Makefile.in: Add a compile target for fake-rfc2553.
- * win/configure.in: Allow cross-compilation by default
+ * win/configure.in: Allow cross-compilation by default.
- * tests/socket.test: Improve the test suite to make more use of
- * tests/remote.tcl: randomized ports to reduce interference with
- tests running in parallel or other services
- on the machine.
+ * tests/socket.test: Improve the test suite to make more use of
+ * tests/remote.tcl: randomized ports to reduce interference with
+ tests running in parallel or other services on
+ the machine.
2010-09-28 Kevin B. Kenny <kennykb@acm.org>
@@ -112,9 +126,9 @@
* generic/tclBasic.c: [Patch 3072080] (minus the itcl
* generic/tclCmdIL.c: update): a saner NRE.
* generic/tclCompExpr.c:
- * generic/tclCompile.c: This makes TclNRExecuteByteCode
- * generic/tclCompile.h: (ex TEBC) to be a normal NRE
- * generic/tclExecute.c: citizen: it loses its special status.
+ * generic/tclCompile.c: This makes TclNRExecuteByteCode (ex TEBC)
+ * generic/tclCompile.h: to be a normal NRE citizen: it loses its
+ * generic/tclExecute.c: special status.
* generic/tclInt.decls: The logic flow within the BC engine is
* generic/tclInt.h: simplified considerably.
* generic/tclIntDecls.h:
@@ -122,7 +136,7 @@
* generic/tclProc.c:
* generic/tclTest.c:
- * generic/tclVar.c: use the macro HasLocalVars everywhere
+ * generic/tclVar.c: Use the macro HasLocalVars everywhere
* generic/tclOOMethod.c (ProcedureMethodVarResolver): avoid code
duplication, let the runtime var resolver call the compiled var
@@ -156,16 +170,15 @@
2010-09-24 Jeff Hobbs <jeffh@ActiveState.com>
* tests/stringComp.test: improved string eq/cmp test coverage
- * generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP
- and INST_STR_EQ/INST_STR_NEQ paths. Speeds up eq/ne/[string eq]
- with obj-aware comparisons and eq/==/ne/!= with length equality
- check.
+ * generic/tclExecute.c (TclExecuteByteCode): merge INST_STR_CMP and
+ INST_STR_EQ/INST_STR_NEQ paths. Speeds up eq/ne/[string eq] with
+ obj-aware comparisons and eq/==/ne/!= with length equality check.
2010-09-24 Andreas Kupries <andreask@activestate.com>
- * tclWinsock.c: [Bug 3056775]: Fixed race condition between thread
- and internal co-thread access of a socket's structure because of
- the thread not using the socketListLock in TcpAccept(). Added
+ * tclWinsock.c: [Bug 3056775]: Fixed race condition between thread and
+ internal co-thread access of a socket's structure because of the
+ thread not using the socketListLock in TcpAccept(). Added
documentation on how the module works to the top.
2010-09-23 Jan Nijtmans <nijtmans@users.sf.net>
@@ -183,27 +196,27 @@
2010-09-23 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tclAppInit.c: Make compilable with -DUNICODE (not
- * win/tclAppInit.c: actived yet), many clean-ups in comments.
+ * unix/tclAppInit.c: Make compilable with -DUNICODE (not activated
+ * win/tclAppInit.c: yet), many clean-ups in comments.
2010-09-22 Miguel Sofer <msofer@users.sf.net>
- * generic/tclExecute: one more DECACHE_STACK_INFO() missing; this
- fixes [Bug 3072640]
+ * generic/tclExecute: [Bug 3072640]: One more DECACHE_STACK_INFO() was
+ missing.
- * tests/execute.test: added execute-10.3 for [Bug 3072640]. The
- test causes a mem failure.
+ * tests/execute.test: Added execute-10.3 for [Bug 3072640]. The test
+ causes a mem failure.
- * generic/tclExecute: protect all possible writes to ::errorInfo
- or ::errorCode with DECACHE_STACK_INFO(), as they could run
- traces. The new calls to be protected are Tcl_ResetResult(),
- Tcl_SetErrorCode(), IllegalExprOperandType(),
- TclExprFloatError(). The error was triggered by [Patch 3072080].
+ * generic/tclExecute: Protect all possible writes to ::errorInfo or
+ ::errorCode with DECACHE_STACK_INFO(), as they could run traces. The
+ new calls to be protected are Tcl_ResetResult(), Tcl_SetErrorCode(),
+ IllegalExprOperandType(), TclExprFloatError(). The error was triggered
+ by [Patch 3072080].
2010-09-22 Jan Nijtmans <nijtmans@users.sf.net>
- * win/tcl.m4: Add kernel32 to LIBS, so the link line for mingw
- * win/configure: is exactly the same as for MSVC++.
+ * win/tcl.m4: Add kernel32 to LIBS, so the link line for
+ * win/configure: mingw is exactly the same as for MSVC++.
2010-09-21 Jeff Hobbs <jeffh@ActiveState.com>
@@ -212,7 +225,7 @@
* generic/tclVar.c (TclLookupSimpleVar, CompareVarKeys):
* generic/tclPathObj.c (Tcl_FSGetNormalizedPath, Tcl_FSEqualPaths):
* generic/tclIOUtil.c (TclFSCwdPointerEquals): peephole opt
- * generic/tclResult.c (TclMergeReturnOptions): use memcmp where
+ * generic/tclResult.c (TclMergeReturnOptions): Use memcmp where
applicable as possible speedup on some libc variants.
2010-09-21 Kevin B. Kenny <kennykb@acm.org>
@@ -234,10 +247,10 @@
2010-09-21 Jan Nijtmans <nijtmans@users.sf.net>
* win/tclWinFile.c: Fix declaration after statement.
- * win/tcl.m4: Add -Wdeclaration-after-statement, so
- * win/configure: this mistake cannot happen again.
- * win/tclWinFCmd.c: [Bug 3069278]: Breakage on head Windows triggered
- * win/tclWinPipe.c: by install-tzdata, final fix
+ * win/tcl.m4: Add -Wdeclaration-after-statement, so this
+ * win/configure: mistake cannot happen again.
+ * win/tclWinFCmd.c: [Bug 3069278]: Breakage on head Windows
+ * win/tclWinPipe.c: triggered by install-tzdata, final fix
2010-09-20 Jan Nijtmans <nijtmans@users.sf.net>
@@ -265,10 +278,10 @@
2010-09-16 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclDecls.h Make Tcl_FindExecutable() work in UNICODE
- * generic/tclEncoding.c compiles (windows-only) as well as ASCII.
- * generic/tclStubInit.c Needed for [FRQ 491789]: setargv() doesn't
- support a unicode cmdline
+ * generic/tclDecls.h: Make Tcl_FindExecutable() work in UNICODE
+ * generic/tclEncoding.c: compiles (windows-only) as well as ASCII.
+ * generic/tclStubInit.c: Needed for [FRQ 491789]: setargv() doesn't
+ support a unicode cmdline.
2010-09-15 Donal K. Fellows <dkf@users.sf.net>
@@ -915,7 +928,7 @@
2010-05-06 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclPkg.c Unnecessary type casts, See Tcl [Patch #2997087]
+ * generic/tclPkg.c: Unnecessary type casts, see [Patch 2997087]
2010-05-04 Jan Nijtmans <nijtmans@users.sf.net>
@@ -1342,7 +1355,7 @@
* generic/tclIndexObj: [FRQ 2974744]: share exception codes
* generic/tclResult.c: further optimization, making use of indexType.
- * generic/tclZlib.c [Bug 2979399]: uninitialized value troubles
+ * generic/tclZlib.c: [Bug 2979399]: uninitialized value troubles
2010-03-30 Donal K. Fellows <dkf@users.sf.net>
@@ -2626,23 +2639,23 @@
2009-11-19 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclInt.h Make all internal initialization
- * generic/tclTest.c routines MODULE_SCOPE
- * generic/tclTestObj.c
- * generic/tclTestProcBodyObj.c
- * generic/tclThreadTest.c
- * unix/Makefile.in Fix [Bug 2883850]: pkgIndex.tcl doesn't
- * unix/tclAppInit.c get created with static Tcl build
- * unix/tclXtTest.c
- * unix/tclXtNotify.c
- * unix/tclUnixTest.c
- * win/Makefile.in
- * win/tcl.m4
- * win/configure (regenerated)
- * win/tclAppInit.c
- * win/tclWinDde.c Always compile with Stubs.
- * win/tclWinReg.c
- * win/tclWinTest.c
+ * generic/tclInt.h: Make all internal initialization
+ * generic/tclTest.c: routines MODULE_SCOPE
+ * generic/tclTestObj.c:
+ * generic/tclTestProcBodyObj.c:
+ * generic/tclThreadTest.c:
+ * unix/Makefile.in: Fix [Bug 2883850]: pkgIndex.tcl doesn't
+ * unix/tclAppInit.c: get created with static Tcl build
+ * unix/tclXtTest.c:
+ * unix/tclXtNotify.c:
+ * unix/tclUnixTest.c:
+ * win/Makefile.in:
+ * win/tcl.m4:
+ * win/configure: (regenerated)
+ * win/tclAppInit.c:
+ * win/tclWinDde.c: Always compile with Stubs.
+ * win/tclWinReg.c:
+ * win/tclWinTest.c:
2009-11-18 Jan Nijtmans <nijtmans@users.sf.net>
@@ -3300,9 +3313,9 @@
* unix/dltest/pkge.c: const addition
* unix/tclUnixThrd.c: Use <pthread.h> in stead of "pthread.h"
* win/tclWinDde.c: Eliminate some more gcc warnings
- * win/tclWinReg.c
- * generic/tclInt.h Change ForIterData, make it const-safe.
- * generic/tclCmdAH.c
+ * win/tclWinReg.c:
+ * generic/tclInt.h: Change ForIterData, make it const-safe.
+ * generic/tclCmdAH.c:
2009-08-12 Don Porter <dgp@users.sourceforge.net>
@@ -3803,7 +3816,7 @@
2009-04-27 Jan Nijtmans <nijtmans@users.sf.net>
* generic/tclIndexObj.c: Reset internal INTERP_ALTERNATE_WRONG_ARGS
- * generic/tclIOCmd.c flag inside the Tcl_WrongNumArgs function,
+ * generic/tclIOCmd.c: flag inside the Tcl_WrongNumArgs function,
so the caller no longer has to do the reset.
2009-04-24 Stuart Cassoff <stwo@users.sf.net>
@@ -4087,7 +4100,7 @@
* generic/tcl.decls: [Bug 218977]: Tcl_DbCkfree needs return value
* generic/tclCkalloc.c
- * generic/tclDecls.h (regenerated)
+ * generic/tclDecls.h: (regenerated)
* generic/tclInt.decls: don't use CONST84/CONST86 here
* generic/tclCompile.h: don't use CONST86 here, comment fixing.
* generic/tclIO.h: don't use CONST86 here, comment fixing.
@@ -4292,41 +4305,41 @@
2009-02-10 Jan Nijtmans <nijtmans@users.sf.net>
- * generic/tclEncoding.c Eliminate some unnessary type casts
- * generic/tclEvent.c some internal const decorations
- * generic/tclExecute.c spacing
- * generic/tclIndexObj.c
- * generic/tclInterp.c
- * generic/tclIO.c
- * generic/tclIOCmd.c
- * generic/tclIORChan.c
- * generic/tclIOUtil.c
- * generic/tclListObj.c
- * generic/tclLiteral.c
- * generic/tclNamesp.c
- * generic/tclObj.c
- * generic/tclOOBasic.c
- * generic/tclPathObj.c
- * generic/tclPkg.c
- * generic/tclProc.c
- * generic/tclRegexp.c
- * generic/tclScan.c
- * generic/tclStringObj.c
- * generic/tclTest.c
- * generic/tclTestProcBodyObj.c
- * generic/tclThread.c
- * generic/tclThreadTest.c
- * generic/tclTimer.c
- * generic/tclTrace.c
- * generic/tclUtil.c
- * generic/tclVar.c
- * generic/tclStubInit.c (regenerated)
+ * generic/tclEncoding.c: Eliminate some unnessary type casts
+ * generic/tclEvent.c: some internal const decorations
+ * generic/tclExecute.c: spacing
+ * generic/tclIndexObj.c:
+ * generic/tclInterp.c:
+ * generic/tclIO.c:
+ * generic/tclIOCmd.c:
+ * generic/tclIORChan.c:
+ * generic/tclIOUtil.c:
+ * generic/tclListObj.c:
+ * generic/tclLiteral.c:
+ * generic/tclNamesp.c:
+ * generic/tclObj.c:
+ * generic/tclOOBasic.c:
+ * generic/tclPathObj.c:
+ * generic/tclPkg.c:
+ * generic/tclProc.c:
+ * generic/tclRegexp.c:
+ * generic/tclScan.c:
+ * generic/tclStringObj.c:
+ * generic/tclTest.c:
+ * generic/tclTestProcBodyObj.c:
+ * generic/tclThread.c:
+ * generic/tclThreadTest.c:
+ * generic/tclTimer.c:
+ * generic/tclTrace.c:
+ * generic/tclUtil.c:
+ * generic/tclVar.c:
+ * generic/tclStubInit.c: (regenerated)
2009-02-10 Jan Nijtmans <nijtmans@users.sf.net>
- * unix/tcl.m4: fix [tcl-Bug 2502365] Building of head on HPUX is
- broken when using the native CC.
- * unix/configure (autoconf-2.59)
+ * unix/tcl.m4: [Bug 2502365]: Building of head on HPUX is broken when
+ using the native CC.
+ * unix/configure: (autoconf-2.59)
2009-02-10 Don Porter <dgp@users.sourceforge.net>
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 94b1ff8..8232551 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -102,7 +102,21 @@ TalInstDesc TalInstructionTable[] = {
{"bitor", ASSEM_1BYTE , INST_BITOR , 2 , 1},
{"bitxor", ASSEM_1BYTE , INST_BITXOR , 2 , 1},
{"concat", ASSEM_CONCAT1, INST_CONCAT1, INT_MIN,1},
+ {"dictAppend",
+ ASSEM_LVT4, INST_DICT_APPEND,
+ 2, 1},
{"dictGet", ASSEM_DICT_GET, INST_DICT_GET, INT_MIN,1},
+ {"dictIncrImm",
+ ASSEM_SINT4_LVT4,
+ INST_DICT_INCR_IMM,
+ 1, 1},
+ {"dictLappend",
+ ASSEM_LVT4, INST_DICT_LAPPEND,
+ 2, 1},
+ {"dictSet", ASSEM_DICT_SET, INST_DICT_SET, INT_MIN,1},
+ {"dictUnset",
+ ASSEM_DICT_UNSET,
+ INST_DICT_UNSET,INT_MIN,1},
{"div", ASSEM_1BYTE, INST_DIV, 2, 1},
{"dup", ASSEM_1BYTE , INST_DUP , 1 , 2},
{"eq", ASSEM_1BYTE , INST_EQ , 2 , 1},
@@ -215,6 +229,7 @@ TalInstDesc TalInstructionTable[] = {
{"mult", ASSEM_1BYTE , INST_MULT , 2 , 1},
{"neq", ASSEM_1BYTE , INST_NEQ , 2 , 1},
{"not", ASSEM_1BYTE, INST_LNOT, 1, 1},
+ {"nsupvar", ASSEM_LVT4, INST_NSUPVAR, 2, 1}.
{"over", ASSEM_OVER, INST_OVER, INT_MIN, -1-1},
{"pop", ASSEM_1BYTE , INST_POP , 1 , 0},
{"reverse", ASSEM_REVERSE, INST_REVERSE, INT_MIN, -1-0},
@@ -258,6 +273,8 @@ TalInstDesc TalInstructionTable[] = {
{"unsetStk",
ASSEM_BOOL, INST_UNSET_STK, 1, 0},
{"uplus", ASSEM_1BYTE, INST_UPLUS, 1, 1},
+ {"upvar", ASSEM_LVT4, INST_UPVAR, 2, 1}.
+ {"variable",ASSEM_LVT4, INST_VARIABLE, 2, 1}.
{NULL, 0, 0,0}
};
@@ -1032,6 +1049,34 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
break;
+ case ASSEM_DICT_SET:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd+1);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
+ case ASSEM_DICT_UNSET:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblind, opnd, opnd);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
case ASSEM_EVAL:
/* TODO - Refactor this stuff into a subroutine
* that takes the inst code, the message ("script" or "expression")
@@ -1287,6 +1332,19 @@ AssembleOneLine(AssembleEnv* assemEnvPtr)
BBEmitInstInt1(assemEnvPtr, tblind, opnd, 0);
break;
+ case ASSEM_SINT4_LVT4:
+ if (parsePtr->numWords != 3) {
+ Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
+ goto cleanup;
+ }
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
+ || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ goto cleanup;
+ }
+ BBEmitInstInt4(assemEnvPtr, tblind, opnd, 0);
+ TclEmitInt4(localVar, envPtr);
+ break;
+
default:
Tcl_Panic("Instruction \"%s\" could not be found, can't happen\n",
Tcl_GetString(instNameObj));
diff --git a/generic/tclAssembly.h b/generic/tclAssembly.h
index 0c8cd61..7f1a36e 100644
--- a/generic/tclAssembly.h
+++ b/generic/tclAssembly.h
@@ -49,7 +49,12 @@ typedef enum TalInstType {
ASSEM_CONCAT1, /* 1-byte unsigned-integer operand count, must be
* strictly positive, consumes N, produces 1 */
ASSEM_DICT_GET, /* 'dict get' and related - consumes N+1 operands,
- * produces 1, N >= 0 */
+ * produces 1, N > 0 */
+ ASSEM_DICT_SET, /* specifies key count and LVT index, consumes N+1 operands,
+ * produces 1, N > 0 */
+ ASSEM_DICT_UNSET,
+ /* specifies key count and LVT index, consumes N operands,
+ * produces 1, N > 0 */
ASSEM_EVAL, /* 'eval' - evaluate a constant script (by compiling it
* in line with the assembly code! I love Tcl!) */
ASSEM_INDEX, /* 4 byte operand, integer or end-integer */
@@ -74,6 +79,9 @@ typedef enum TalInstType {
ASSEM_PUSH, /* one literal operand */
ASSEM_REVERSE, /* REVERSE: 4-byte operand count, consumes N, produces N */
ASSEM_SINT1, /* One 1-byte signed-integer operand (INCR_STK_IMM) */
+ ASSEM_SINT4_LVT4,
+ /* Signed 4-byte integer operand followed by LVT entry.
+ * Fixed arity */
} TalInstType;
/* Description of an instruction recognized by the assembler. */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 6f3701c..3f7c420 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.494.2.4 2010/10/02 01:38:27 kennykb Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.494.2.5 2010/10/02 16:04:29 kennykb Exp $
*/
#include "tclInt.h"
@@ -5768,6 +5768,16 @@ TEBCresume(
Tcl_DictObjPut(NULL, dictPtr, OBJ_UNDER_TOS, valuePtr);
} else {
Tcl_AppendObjToObj(valuePtr, OBJ_AT_TOS);
+
+ /*
+ * Must invalidate the string representation of dictionary
+ * here because we have directly updated the internal
+ * representation; if we don't, callers could see the wrong
+ * string rep despite the internal version of the dictionary
+ * having the correct value. [Bug 3079830]
+ */
+
+ TclInvalidateStringRep(dictPtr);
}
break;
case INST_DICT_LAPPEND:
@@ -5798,6 +5808,16 @@ TEBCresume(
}
goto gotError;
}
+
+ /*
+ * Must invalidate the string representation of dictionary
+ * here because we have directly updated the internal
+ * representation; if we don't, callers could see the wrong
+ * string rep despite the internal version of the dictionary
+ * having the correct value. [Bug 3079830]
+ */
+
+ TclInvalidateStringRep(dictPtr);
}
break;
default:
@@ -6021,6 +6041,9 @@ TEBCresume(
if (allocdict) {
dictPtr = Tcl_DuplicateObj(dictPtr);
}
+ if (length > 0) {
+ TclInvalidateStringRep(dictPtr);
+ }
for (i=0 ; i<length ; i++) {
Var *var2Ptr = LOCAL(duiPtr->varIndices[i]);
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 24a29a5..3161a46 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.174.2.2 2010/10/01 13:34:09 kennykb Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.174.2.3 2010/10/02 16:04:29 kennykb Exp $
*/
#include "tclInt.h"
@@ -55,9 +55,9 @@ char *tclEmptyStringRep = &tclEmptyString;
#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS)
/*
- * Structure for tracking the source file and line number where a given Tcl_Obj
- * was allocated. We also track the pointer to the Tcl_Obj itself, for sanity
- * checking purposes.
+ * Structure for tracking the source file and line number where a given
+ * Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
+ * for sanity checking purposes.
*/
typedef struct ObjData {
@@ -1486,7 +1486,7 @@ TclFreeObj(
}
}
}
-#endif
+#endif /* TCL_MEM_DEBUG */
/*
*----------------------------------------------------------------------
@@ -1512,7 +1512,6 @@ TclObjBeingDeleted(
{
return (objPtr->length == -1);
}
-
/*
*----------------------------------------------------------------------
@@ -1706,7 +1705,6 @@ Tcl_InvalidateStringRep(
{
TclInvalidateStringRep(objPtr);
}
-
/*
*----------------------------------------------------------------------
@@ -3259,7 +3257,7 @@ UpdateStringOfBignum(
Tcl_Panic("conversion failure in UpdateStringOfBignum");
}
objPtr->bytes = stringVal;
- objPtr->length = size - 1; /* size includes a trailing null byte */
+ objPtr->length = size - 1; /* size includes a trailing NUL byte. */
}
/*
@@ -3566,6 +3564,24 @@ Tcl_SetBignumObj(
TclSetBignumIntRep(objPtr, bignumValue);
}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclSetBignumIntRep --
+ *
+ * Install a bignum into the internal representation of an object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Object internal representation is updated and object type is set. The
+ * bignum value is cleared, since ownership has transferred to the
+ * object.
+ *
+ *----------------------------------------------------------------------
+ */
+
void
TclSetBignumIntRep(
Tcl_Obj *objPtr,
@@ -3576,8 +3592,9 @@ TclSetBignumIntRep(
/*
* Clear the mp_int value.
- * Don't call mp_clear() because it would free the digit array
- * we just packed into the Tcl_Obj.
+ *
+ * Don't call mp_clear() because it would free the digit array we just
+ * packed into the Tcl_Obj.
*/
bignumValue->dp = NULL;
@@ -3590,9 +3607,17 @@ TclSetBignumIntRep(
*
* TclGetNumberFromObj --
*
+ * Extracts a number (of any possible numeric type) from an object.
+ *
* Results:
+ * Whether the extraction worked. The type is stored in the variable
+ * referred to by the typePtr argument, and a pointer to the
+ * representation is stored in the variable referred to by the
+ * clientDataPtr.
*
* Side effects:
+ * Can allocate thread-specific data for handling the copy-out space for
+ * bignums; this space is shared within a thread.
*
*----------------------------------------------------------------------
*/
@@ -3611,18 +3636,18 @@ TclGetNumberFromObj(
} else {
*typePtr = TCL_NUMBER_DOUBLE;
}
- *clientDataPtr = &(objPtr->internalRep.doubleValue);
+ *clientDataPtr = &objPtr->internalRep.doubleValue;
return TCL_OK;
}
if (objPtr->typePtr == &tclIntType) {
*typePtr = TCL_NUMBER_LONG;
- *clientDataPtr = &(objPtr->internalRep.longValue);
+ *clientDataPtr = &objPtr->internalRep.longValue;
return TCL_OK;
}
#ifndef NO_WIDE_TYPE
if (objPtr->typePtr == &tclWideIntType) {
*typePtr = TCL_NUMBER_WIDE;
- *clientDataPtr = &(objPtr->internalRep.wideValue);
+ *clientDataPtr = &objPtr->internalRep.wideValue;
return TCL_OK;
}
#endif
diff --git a/tests/assemble.test b/tests/assemble.test
index e901e38..b86e728 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -1255,7 +1255,7 @@ test assemble-10.7 {expr - noncompilable} {
-result {1 {assembly code may not contain substitutions} {TCL ASSEM NOSUBST}}
}
-# assemble-11 - ASSEM_LVT4 (exist and existArray)
+# assemble-11 - ASSEM_LVT4 (exist, existArray, dictAppend, dictLappend)
test assemble-11.1 {exist - wrong # args} {
-body {
@@ -1310,6 +1310,30 @@ test assemble-11.5 {existArray} {
-cleanup {rename x {}}
}
+test assemble-11.6 {dictAppend} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; push 22; dictAppend dict}
+ }
+ x
+ }
+ -result {a 1 b 222 c 3}
+ -cleanup {rename x {}}
+}
+
+test assemble-11.7 {dictLappend} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; push 2; dictLappend dict}
+ }
+ x
+ }
+ -result {a 1 b {2 2} c 3}
+ -cleanup {rename x {}}
+}
+
# assemble-12 - ASSEM_LVT1 (incr and incrArray)
test assemble-12.1 {incr - wrong # args} {
@@ -2642,6 +2666,220 @@ test assemble-25.6 {dictGet - 1 index} {
-result 1
}
+# assemble-26 - dict set
+
+test assemble-26.1 {dict set - wrong # args} {
+ -body {
+ assemble {dictSet 1}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-26.2 {dict get - wrong # args} {
+ -body {
+ assemble {dictSet too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-26.3 {dictSet - bad subst} {
+ -body {
+ assemble {dictSet 1 $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+
+test assemble-26.4 {dictSet - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictSet rubbish foo}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+
+test assemble-26.5 {dictSet - zero operand count} {
+ -body {
+ proc x {} {
+ assemble {dictSet 0 foo}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+
+test assemble-26.6 {dictSet - bad local} {
+ -body {
+ proc x {} {
+ assemble {dictSet 1 ::foo::bar}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+ -cleanup {rename x {}; unset result}
+}
+
+test assemble-26.7 {dictSet} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; push 4; dictSet 1 dict}
+ }
+ x
+ }
+ -result {a 1 b 4 c 3}
+ -cleanup {rename x {}}
+}
+
+# assemble-27 - dictUnset
+
+test assemble-27.1 {dictUnset - wrong # args} {
+ -body {
+ assemble {dictUnset 1}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-27.2 {dictUnset - wrong # args} {
+ -body {
+ assemble {dictUnset too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-27.3 {dictUnset - bad subst} {
+ -body {
+ assemble {dictUnset 1 $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+
+test assemble-27.4 {dictUnset - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictUnset rubbish foo}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+
+test assemble-27.5 {dictUnset - zero operand count} {
+ -body {
+ proc x {} {
+ assemble {dictUnset 0 foo}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {operand must be positive} {TCL ASSEM POSITIVE}}
+ -cleanup {rename x {}; unset result}
+}
+
+test assemble-27.6 {dictUnset - bad local} {
+ -body {
+ proc x {} {
+ assemble {dictUnset 1 ::foo::bar}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+ -cleanup {rename x {}; unset result}
+}
+
+test assemble-27.7 {dictUnset} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; dictUnset 1 dict}
+ }
+ x
+ }
+ -result {a 1 c 3}
+ -cleanup {rename x {}}
+}
+
+# assemble-28 - dictIncrImm
+
+test assemble-28.1 {dictIncrImm - wrong # args} {
+ -body {
+ assemble {dictIncrImm 1}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-28.2 {dictIncrImm - wrong # args} {
+ -body {
+ assemble {dictIncrImm too many args}
+ }
+ -returnCodes error
+ -match glob
+ -result {wrong # args*}
+}
+
+test assemble-28.3 {dictIncrImm - bad subst} {
+ -body {
+ assemble {dictIncrImm 1 $foo}
+ }
+ -returnCodes error
+ -match glob
+ -result {assembly code may not contain substitutions}
+}
+
+test assemble-28.4 {dictIncrImm - not a number} {
+ -body {
+ proc x {} {
+ assemble {dictIncrImm rubbish foo}
+ }
+ x
+ }
+ -returnCodes error
+ -result {expected integer but got "rubbish"}
+ -cleanup {rename x {}}
+}
+
+test assemble-28.5 {dictIncrImm - bad local} {
+ -body {
+ proc x {} {
+ assemble {dictIncrImm 1 ::foo::bar}
+ }
+ list [catch x result] $result $::errorCode
+ }
+ -result {1 {variable "::foo::bar" is not local} {TCL ASSEM NONLOCAL ::foo::bar}}
+ -cleanup {rename x {}; unset result}
+}
+
+test assemble-28.6 {dictIncrImm} {
+ -body {
+ proc x {} {
+ set dict {a 1 b 2 c 3}
+ assemble {push b; dictIncrImm 42 dict}
+ }
+ x
+ }
+ -result {a 1 b 44 c 3}
+ -cleanup {rename x {}}
+}
+
test assemble-30.1 {unbalanced stack} {
-body {
list \
diff --git a/tests/dict.test b/tests/dict.test
index c7d186d..b05208f 100644
--- a/tests/dict.test
+++ b/tests/dict.test
@@ -9,7 +9,7 @@
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: dict.test,v 1.37 2010/05/20 08:37:09 ferrieux Exp $
+# RCS: @(#) $Id: dict.test,v 1.37.2.1 2010/10/02 16:04:29 kennykb Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2
@@ -426,6 +426,9 @@ test dict-12.10 {dict lappend command: write failure} -setup {
} -returnCodes error -cleanup {
unset dictVar
} -result {can't set "dictVar": variable is array}
+test dict-12.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+ apply {{} {set d {a 1 b 2 c 3}; dict lappend d b 22}}
+} {a 1 b {2 22} c 3}
test dict-13.1 {dict append command} -body {
set dictv {a a}
@@ -487,6 +490,9 @@ test dict-13.9 {dict append command: write failure} -setup {
test dict-13.10 {compiled dict append: crash case} {
apply {{} {dict append dictVar a o k}}
} {a ok}
+test dict-13.11 {compiled dict append: invalidate string rep - Bug 3079830} {
+ apply {{} {set d {a 1 b 2 c 3}; dict append d b 22}}
+} {a 1 b 222 c 3}
test dict-14.1 {dict for command: syntax} -returnCodes error -body {
dict for
generated by cgit v0.12 at 2024-11-20 06:26:32 (GMT)