summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog39
-rw-r--r--changes6
-rw-r--r--generic/tclAssembly.c265
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclFileName.c14
-rw-r--r--generic/tclIO.c9
-rw-r--r--generic/tclIORChan.c43
-rw-r--r--generic/tclIORTrans.c36
-rw-r--r--generic/tclObj.c27
-rw-r--r--generic/tclProc.c9
-rwxr-xr-xgeneric/tclStrToD.c6
-rw-r--r--generic/tclVar.c3
-rw-r--r--generic/tclZlib.c18
-rw-r--r--tests/assemble.test82
-rw-r--r--tests/ioTrans.test2
15 files changed, 321 insertions, 246 deletions
diff --git a/ChangeLog b/ChangeLog
index f9da582..7e217ef 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,40 @@
+2011-08-05 Don Porter <dgp@users.sourceforge.net>
+
+ *** 8.6b2 TAGGED FOR RELEASE ***
+
+ * changes: Updates for 8.6b2 release.
+
+2011-08-05 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c (AssembleOneLine): Ensure that memory isn't
+ leaked when an unknown instruction is encountered. Also simplify code
+ through use of Tcl_ObjPrintf in error message generation.
+
+ * generic/tclZlib.c (ZlibTransformClose): [Bug 3386197]: Plug a memory
+ leak found by Miguel with valgrind, and ensure that the correct
+ direction's buffers are released.
+
+2011-08-04 Miguel Sofer <msofer@users.sf.net>
+
+ * generic/tclVar.c (TclPtrSetVar): Fix valgrind-detected error when
+ newValuePtr is the interp's result obj.
+
+2011-08-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c (FreeAssemblyEnv): [Bug 3384840]: Plug another
+ possible memory leak due to over-complex code for freeing the table of
+ labels.
+
+2011-08-04 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclAssembly.c (AssembleOneLine, GetBooleanOperand)
+ (GetIntegerOperand, GetListIndexOperand, FindLocalVar): [Bug 3384840]:
+ A Tcl_Obj is allocated by GetNextOperand, so callers of it must not
+ hold a reference to one in the 'out' parameter when calling it. This
+ was causing a great many memory leaks.
+ * tests/assemble.test (assemble-51.*): Added group of memory leak
+ tests.
+
2011-08-02 Don Porter <dgp@users.sourceforge.net>
* changes: Updates for 8.6b2 release.
@@ -135,7 +172,7 @@
2011-07-07 Miguel Sofer <msofer@users.sf.net>
- * generic/tclBasic.c: add missing INT2PTR
+ * generic/tclBasic.c: Add missing INT2PTR
2011-07-03 Donal K. Fellows <dkf@users.sf.net>
diff --git a/changes b/changes
index 76ed3e8..88ea3e6 100644
--- a/changes
+++ b/changes
@@ -7532,7 +7532,7 @@ evaluation in extensions (sofer,kenny)
2009-05-08 (bug fix)[2414858] tailcall in oo constructor (fellows)
-2009-05-14 (new subcommand) [info object namespace] (fellows)
+2009-05-14 (new subcommand)[TIP 354] [info object namespace] (fellows)
2009-05-29 (platform support) account for ia64_32 (kupries)
=> platform 1.0.5
@@ -7563,7 +7563,7 @@ avoid otherwise very tricky multi-thread finalization bugs. (staplin,ferrieux)
2009-07-16 (bug fix)[2819200] underflow settings on MIPS systems (porter)
-2009-07-19 (interface) new public routine Tcl_GetObjectName() (fellows)
+2009-07-19 (interface)[TIP 354] new routine Tcl_GetObjectName() (fellows)
2009-07-20 (performance) favor [string is] success cases over empty (fellows)
@@ -7953,4 +7953,4 @@ memory with buffer backup (ferrieux)
Many more Tcl built-in command errors now set an -errorcode.
---- Released 8.6b2, August 5, 2011 --- See ChangeLog for details ---
+--- Released 8.6b2, August 8, 2011 --- See ChangeLog for details ---
diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c
index 1b87886..f45ae07 100644
--- a/generic/tclAssembly.c
+++ b/generic/tclAssembly.c
@@ -1,5 +1,5 @@
/*
- * tclAssembly,c --
+ * tclAssembly.c --
*
* Assembler for Tcl bytecodes.
*
@@ -84,7 +84,7 @@ typedef struct BasicBlock {
* unresolved */
int initialStackDepth; /* Absolute stack depth on entry */
int minStackDepth; /* Low-water relative stack depth */
- int maxStackDepth; /* High-water relative stack depth */
+ int maxStackDepth; /* High-water relative stack depth */
int finalStackDepth; /* Relative stack depth on exit */
enum BasicBlockCatchState catchState;
/* State of the block for 'catch' analysis */
@@ -193,7 +193,7 @@ typedef enum TalInstType {
typedef struct TalInstDesc {
const char *name; /* Name of instruction. */
- TalInstType instType; /* The type of instruction */
+ TalInstType instType; /* The type of instruction */
int tclInstCode; /* Instruction code. For instructions having
* 1- and 4-byte variables, tclInstCode is
* ((1byte)<<8) || (4byte) */
@@ -831,16 +831,20 @@ CompileAssembleObj(
if (objPtr->typePtr == &assembleCodeType) {
namespacePtr = iPtr->varFramePtr->nsPtr;
codePtr = objPtr->internalRep.otherValuePtr;
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)
- || (codePtr->nsPtr != namespacePtr)
- || (codePtr->nsEpoch != namespacePtr->resolverEpoch)
- || (codePtr->localCachePtr
- != iPtr->varFramePtr->localCachePtr)) {
- FreeAssembleCodeInternalRep(objPtr);
- } else {
+ if (((Interp *) *codePtr->interpHandle == iPtr)
+ && (codePtr->compileEpoch == iPtr->compileEpoch)
+ && (codePtr->nsPtr == namespacePtr)
+ && (codePtr->nsEpoch == namespacePtr->resolverEpoch)
+ && (codePtr->localCachePtr
+ == iPtr->varFramePtr->localCachePtr)) {
return codePtr;
}
+
+ /*
+ * Not valid, so free it and regenerate.
+ */
+
+ FreeAssembleCodeInternalRep(objPtr);
}
/*
@@ -967,7 +971,7 @@ TclCompileAssembleCmd(
static int
TclAssembleCode(
- CompileEnv *envPtr, /* Compilation environment that is to receive
+ CompileEnv *envPtr, /* Compilation environment that is to receive
* the generated bytecode */
const char* codePtr, /* Assembly-language code to be processed */
int codeLen, /* Length of the code */
@@ -1173,24 +1177,10 @@ FreeAssemblyEnv(
}
/*
- * Free the label hash.
- */
-
- while (1) {
- Tcl_HashEntry* hashEntry;
- Tcl_HashSearch hashSearch;
-
- hashEntry = Tcl_FirstHashEntry(&assemEnvPtr->labelHash, &hashSearch);
- if (hashEntry == NULL) {
- break;
- }
- Tcl_DeleteHashEntry(hashEntry);
- }
-
- /*
* Dispose what's left.
*/
+ Tcl_DeleteHashTable(&assemEnvPtr->labelHash);
TclStackFree(interp, assemEnvPtr->parsePtr);
TclStackFree(interp, assemEnvPtr);
}
@@ -1222,13 +1212,12 @@ AssembleOneLine(
Tcl_Parse* parsePtr = assemEnvPtr->parsePtr;
/* Parse of the line of code */
Tcl_Token* tokenPtr; /* Current token within the line of code */
- Tcl_Obj* instNameObj = NULL;
- /* Name of the instruction */
+ Tcl_Obj* instNameObj; /* Name of the instruction */
int tblIdx; /* Index in TalInstructionTable of the
* instruction */
enum TalInstType instType; /* Type of the instruction */
Tcl_Obj* operand1Obj = NULL;
- /* First operand to the instruction */
+ /* First operand to the instruction */
const char* operand1; /* String rep of the operand */
int operand1Len; /* String length of the operand */
int opnd; /* Integer representation of an operand */
@@ -1244,8 +1233,6 @@ AssembleOneLine(
*/
tokenPtr = parsePtr->tokenPtr;
- instNameObj = Tcl_NewObj();
- Tcl_IncrRefCount(instNameObj);
if (GetNextOperand(assemEnvPtr, &tokenPtr, &instNameObj) != TCL_OK) {
return TCL_ERROR;
}
@@ -1257,7 +1244,7 @@ AssembleOneLine(
if (Tcl_GetIndexFromObjStruct(interp, instNameObj,
&TalInstructionTable[0].name, sizeof(TalInstDesc), "instruction",
TCL_EXACT, &tblIdx) != TCL_OK) {
- return TCL_ERROR;
+ goto cleanup;
}
/*
@@ -1326,8 +1313,11 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "boolean varName");
goto cleanup;
}
- if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ if (GetBooleanOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, opnd, 0);
@@ -1365,8 +1355,11 @@ AssembleOneLine(
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd+1);
@@ -1379,8 +1372,11 @@ AssembleOneLine(
goto cleanup;
}
if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || CheckStrictlyPositive(interp, opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ || CheckStrictlyPositive(interp, opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, opnd);
@@ -1574,7 +1570,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInst1or4(assemEnvPtr, tblIdx, localVar, 0);
@@ -1585,8 +1582,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)) {
goto cleanup;
}
BBEmitInstInt1(assemEnvPtr, tblIdx, localVar, 0);
@@ -1597,8 +1594,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varName imm8");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0
- || CheckOneByte(interp, localVar)
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0 || CheckOneByte(interp, localVar)
|| GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
|| CheckSignedOneByte(interp, opnd)) {
goto cleanup;
@@ -1612,7 +1609,8 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "varname");
goto cleanup;
}
- if ((localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) < 0) {
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, localVar, 0);
@@ -1674,8 +1672,11 @@ AssembleOneLine(
Tcl_WrongNumArgs(interp, 1, &instNameObj, "count varName");
goto cleanup;
}
- if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK
- || (localVar = FindLocalVar(assemEnvPtr, &tokenPtr)) == -1) {
+ if (GetIntegerOperand(assemEnvPtr, &tokenPtr, &opnd) != TCL_OK) {
+ goto cleanup;
+ }
+ localVar = FindLocalVar(assemEnvPtr, &tokenPtr);
+ if (localVar < 0) {
goto cleanup;
}
BBEmitInstInt4(assemEnvPtr, tblIdx, opnd, 0);
@@ -1689,9 +1690,7 @@ AssembleOneLine(
status = TCL_OK;
cleanup:
- if (instNameObj) {
- Tcl_DecrRefCount(instNameObj);
- }
+ Tcl_DecrRefCount(instNameObj);
if (operand1Obj) {
Tcl_DecrRefCount(operand1Obj);
}
@@ -1873,7 +1872,7 @@ MoveExceptionRangesToBasicBlock(
curr_bb, exceptionCount, savedExceptArrayNext);
curr_bb->foreignExceptionBase = savedExceptArrayNext;
curr_bb->foreignExceptionCount = exceptionCount;
- curr_bb->foreignExceptions =
+ curr_bb->foreignExceptions =
ckalloc(exceptionCount * sizeof(ExceptionRange));
memcpy(curr_bb->foreignExceptions,
envPtr->exceptArrayPtr + savedExceptArrayNext,
@@ -1920,7 +1919,6 @@ CreateMirrorJumpTable(
Tcl_HashEntry* hashEntry; /* Entry for a key in the hashtable */
int isNew; /* Flag==1 if the key is not yet in the
* table. */
- Tcl_Obj* result; /* Error message */
int i;
if (Tcl_ListObjGetElements(interp, jumps, &objc, &objv) != TCL_OK) {
@@ -1956,17 +1954,15 @@ CreateMirrorJumpTable(
&isNew);
if (!isNew) {
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj(
- "duplicate entry in jump table for \"", -1);
- Tcl_AppendObjToObj(result, objv[i]);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate entry in jump table for \"%s\"",
+ Tcl_GetString(objv[i])));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPJUMPTABLEENTRY");
DeleteMirrorJumpTable(jtPtr);
return TCL_ERROR;
}
}
- Tcl_SetHashValue(hashEntry, (ClientData) objv[i+1]);
+ Tcl_SetHashValue(hashEntry, objv[i+1]);
Tcl_IncrRefCount(objv[i+1]);
}
DEBUG_PRINT("}\n");
@@ -2087,17 +2083,14 @@ GetBooleanOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj = Tcl_NewObj();
- /* Integer from the source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
/*
* Extract the next token as a string.
*/
- Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
- Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
@@ -2143,17 +2136,14 @@ GetIntegerOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj = Tcl_NewObj();
- /* Integer from the source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
/*
* Extract the next token as a string.
*/
- Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
- Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
@@ -2199,17 +2189,14 @@ GetListIndexOperand(
Tcl_Token* tokenPtr = *tokenPtrPtr;
/* INOUT: Pointer to the next token in the
* source code */
- Tcl_Obj* intObj = Tcl_NewObj();
- /* Integer from the source code */
+ Tcl_Obj* intObj; /* Integer from the source code */
int status; /* Tcl status return */
/*
* Extract the next token as a string.
*/
- Tcl_IncrRefCount(intObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &intObj) != TCL_OK) {
- Tcl_DecrRefCount(intObj);
return TCL_ERROR;
}
@@ -2254,21 +2241,19 @@ FindLocalVar(
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
Tcl_Token* tokenPtr = *tokenPtrPtr;
- /* INOUT: Pointer to the next token
- * in the source code */
- Tcl_Obj* varNameObj = Tcl_NewObj();
- /* Name of the variable */
+ /* INOUT: Pointer to the next token in the
+ * source code. */
+ Tcl_Obj* varNameObj; /* Name of the variable */
const char* varNameStr;
int varNameLen;
int localVar; /* Index of the variable in the LVT */
- Tcl_IncrRefCount(varNameObj);
if (GetNextOperand(assemEnvPtr, tokenPtrPtr, &varNameObj) != TCL_OK) {
- Tcl_DecrRefCount(varNameObj);
return -1;
}
varNameStr = Tcl_GetStringFromObj(varNameObj, &varNameLen);
if (CheckNamespaceQualifiers(interp, varNameStr, varNameLen)) {
+ Tcl_DecrRefCount(varNameObj);
return -1;
}
localVar = TclFindCompiledLocal(varNameStr, varNameLen, 1, envPtr);
@@ -2307,14 +2292,12 @@ CheckNamespaceQualifiers(
const char* name, /* Variable name to check */
int nameLen) /* Length of the variable */
{
- Tcl_Obj* result; /* Error message */
const char* p;
+
for (p = name; p+2 < name+nameLen; p++) {
if ((*p == ':') && (p[1] == ':')) {
- result = Tcl_NewStringObj("variable \"", -1);
- Tcl_AppendToObj(result, name, -1);
- Tcl_AppendToObj(result, "\" is not local", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "variable \"%s\" is not local", name));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NONLOCAL", name, NULL);
return TCL_ERROR;
}
@@ -2485,7 +2468,6 @@ DefineLabel(
Tcl_HashEntry* entry; /* Label's entry in the symbol table */
int isNew; /* Flag == 1 iff the label was previously
* undefined */
- Tcl_Obj* result; /* Error message */
/* TODO - This can now be simplified! */
@@ -2501,14 +2483,11 @@ DefineLabel(
* This is a duplicate label.
*/
- if (assemEnvPtr-> flags & (TCL_EVAL_DIRECT)) {
- result = Tcl_NewStringObj(
- "duplicate definition of label \"", -1);
- Tcl_AppendToObj(result, labelName, -1);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL",
- labelName, NULL);
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "duplicate definition of label \"%s\"", labelName));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "DUPLABEL", labelName,
+ NULL);
}
return TCL_ERROR;
}
@@ -2545,7 +2524,7 @@ StartBasicBlock(
{
CompileEnv* envPtr = assemEnvPtr->envPtr;
/* Compilation environment */
- BasicBlock* newBB; /* BasicBlock structure for the new block */
+ BasicBlock* newBB; /* BasicBlock structure for the new block */
BasicBlock* currBB = assemEnvPtr->curr_bb;
/*
@@ -2707,8 +2686,10 @@ FinishAssembly(
return TCL_ERROR;
}
- /* TODO - Check for unreachable code */
- /* Maybe not - unreachable code is Mostly Harmless. */
+ /*
+ * TODO - Check for unreachable code. Or maybe not; unreachable code is
+ * Mostly Harmless.
+ */
return TCL_OK;
}
@@ -2766,7 +2747,7 @@ CalculateJumpRelocations(
motion = 0;
for (bbPtr = assemEnvPtr->head_bb;
bbPtr != NULL;
- bbPtr=bbPtr->successor1) {
+ bbPtr = bbPtr->successor1) {
/*
* Advance the basic block start offset by however many bytes we
* have inserted in the code up to this point
@@ -2866,8 +2847,7 @@ CheckJumpTableLabels(
Tcl_GetString(symbolObj));
DEBUG_PRINT(" %s -> %s (%d)\n",
(char*) Tcl_GetHashKey(symHash, symEntryPtr),
- Tcl_GetString(symbolObj),
- (valEntryPtr != NULL));
+ Tcl_GetString(symbolObj), (valEntryPtr != NULL));
if (valEntryPtr == NULL) {
ReportUndefinedLabel(assemEnvPtr, bbPtr, symbolObj);
return TCL_ERROR;
@@ -2890,6 +2870,7 @@ CheckJumpTableLabels(
*
*-----------------------------------------------------------------------------
*/
+
static void
ReportUndefinedLabel(
AssemblyEnv* assemEnvPtr, /* Assembly environment */
@@ -2901,13 +2882,10 @@ ReportUndefinedLabel(
/* Compilation environment */
Tcl_Interp* interp = (Tcl_Interp*) envPtr->iPtr;
/* Tcl interpreter */
- Tcl_Obj* result; /* Error message */
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- result = Tcl_NewStringObj("undefined label \"", -1);
- Tcl_AppendObjToObj(result, jumpTarget);
- Tcl_AppendToObj(result, "\"", -1);
- Tcl_SetObjResult(interp, result);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "undefined label \"%s\"", Tcl_GetString(jumpTarget)));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "NOLABEL",
Tcl_GetString(jumpTarget), NULL);
Tcl_SetErrorLine(interp, bbPtr->jumpLine);
@@ -3052,8 +3030,7 @@ ResolveJumpTableTargets(
auxDataIndex = TclGetInt4AtPtr(envPtr->codeStart + bbPtr->jumpOffset + 1);
DEBUG_PRINT("bbPtr = %p jumpOffset = %d auxDataIndex = %d\n",
bbPtr, bbPtr->jumpOffset, auxDataIndex);
- realJumpTablePtr = (JumptableInfo*)
- envPtr->auxDataArrayPtr[auxDataIndex].clientData;
+ realJumpTablePtr = envPtr->auxDataArrayPtr[auxDataIndex].clientData;
realJumpHashPtr = &realJumpTablePtr->hashTable;
/*
@@ -3161,7 +3138,6 @@ CheckNonThrowingBlock(
int bound; /* Bytecode offset following the last
* instruction of the block. */
unsigned char opcode; /* Current bytecode instruction */
- Tcl_Obj* retval; /* Error message */
/*
* Determine where in the code array the basic block ends.
@@ -3191,13 +3167,12 @@ CheckNonThrowingBlock(
*/
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- retval = Tcl_NewStringObj("\"", -1);
- Tcl_AppendToObj(retval, tclInstructionTable[opcode].name, -1);
- Tcl_AppendToObj(retval, "\" instruction may not appear in "
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "\"%s\" instruction may not appear in "
"a context where an exception has been "
- "caught and not disposed of.", -1);
+ "caught and not disposed of.",
+ tclInstructionTable[opcode].name));
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADTHROW", NULL);
- Tcl_SetObjResult(interp, retval);
AddBasicBlockRangeToErrorInfo(assemEnvPtr, blockPtr);
}
return TCL_ERROR;
@@ -3230,7 +3205,7 @@ BytecodeMightThrow(
*/
int min = 0;
- int max = sizeof(NonThrowingByteCodes)-1;
+ int max = sizeof(NonThrowingByteCodes) - 1;
int mid;
unsigned char c;
@@ -3371,7 +3346,11 @@ StackCheckBasicBlock(
if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"inconsistent stack depths on two execution paths", -1));
- /* TODO - add execution trace of both paths */
+
+ /*
+ * TODO - add execution trace of both paths
+ */
+
Tcl_SetErrorLine(interp, blockPtr->startLine);
Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
}
@@ -3504,8 +3483,6 @@ StackCheckExit(
int depth; /* Net stack effect */
int litIndex; /* Index in the literal pool of the empty
* string */
- Tcl_Obj* depthObj; /* Net stack effect for an error message */
- Tcl_Obj* resultObj; /* Error message from this procedure */
BasicBlock* curr_bb = assemEnvPtr->curr_bb;
/* Final basic block in the assembly */
@@ -3516,51 +3493,45 @@ StackCheckExit(
*/
if (curr_bb->flags & BB_VISITED) {
- /*
+ /*
* Exit with no operands; push an empty one.
*/
- depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
- if (depth == 0) {
- /*
+ depth = curr_bb->finalStackDepth + curr_bb->initialStackDepth;
+ if (depth == 0) {
+ /*
* Emit a 'push' of the empty literal.
*/
- litIndex = TclRegisterNewLiteral(envPtr, "", 0);
+ litIndex = TclRegisterNewLiteral(envPtr, "", 0);
- /*
+ /*
* Assumes that 'push' is at slot 0 in TalInstructionTable.
*/
- BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
- ++depth;
- }
+ BBEmitInst1or4(assemEnvPtr, 0, litIndex, 0);
+ ++depth;
+ }
- /*
+ /*
* Exit with unbalanced stack.
*/
- if (depth != 1) {
- if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
- depthObj = Tcl_NewIntObj(depth);
- Tcl_IncrRefCount(depthObj);
- resultObj = Tcl_NewStringObj(
- "stack is unbalanced on exit from the code (depth=",
- -1);
- Tcl_AppendObjToObj(resultObj, depthObj);
- Tcl_DecrRefCount(depthObj);
- Tcl_AppendToObj(resultObj, ")", -1);
- Tcl_SetObjResult(interp, resultObj);
- Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
- }
- return TCL_ERROR;
- }
-
- /*
+ if (depth != 1) {
+ if (assemEnvPtr->flags & TCL_EVAL_DIRECT) {
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "stack is unbalanced on exit from the code (depth=%d)",
+ depth));
+ Tcl_SetErrorCode(interp, "TCL", "ASSEM", "BADSTACK", NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
* Record stack usage.
*/
- envPtr->currStackDepth += depth;
+ envPtr->currStackDepth += depth;
}
return TCL_OK;
@@ -3725,8 +3696,10 @@ ProcessCatchesInBasicBlock(
jumpEnclosing = enclosing;
jumpState = state;
- /* TODO: Make sure that the test cases include validating
- * that a natural loop can't include 'beginCatch' or 'endCatch' */
+ /*
+ * TODO: Make sure that the test cases include validating that a natural
+ * loop can't include 'beginCatch' or 'endCatch'
+ */
if (bbPtr->flags & BB_BEGINCATCH) {
/*
@@ -3870,8 +3843,8 @@ BuildExceptionRanges(
int catchDepth = 0; /* Current catch depth */
int maxCatchDepth = 0; /* Maximum catch depth in the program */
BasicBlock** catches; /* Stack of catches in progress */
- int* catchIndices; /* Indices of the exception ranges
- * of catches in progress */
+ int* catchIndices; /* Indices of the exception ranges of catches
+ * in progress */
int i;
/*
@@ -4120,7 +4093,7 @@ RestoreEmbeddedExceptionRanges(
* range as reinstalled */
ExceptionRange* range; /* Current foreign exception range */
unsigned char opcode; /* Current instruction's opcode */
- int catchIndex; /* Index of the exception range to which the
+ int catchIndex; /* Index of the exception range to which the
* current instruction refers */
int i;
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c46510c..a44d736 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3645,12 +3645,8 @@ Tcl_GetMathFuncInfo(
*/
if (cmdPtr == NULL) {
- Tcl_Obj *message;
-
- TclNewLiteralStringObj(message, "unknown math function \"");
- Tcl_AppendToObj(message, name, -1);
- Tcl_AppendToObj(message, "\"", 1);
- Tcl_SetObjResult(interp, message);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "unknown math function \"%s\"", name));
Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "MATHFUNC", name, NULL);
*numArgsPtr = -1;
*argTypesPtr = NULL;
diff --git a/generic/tclFileName.c b/generic/tclFileName.c
index 05ecb04..8ed6f96 100644
--- a/generic/tclFileName.c
+++ b/generic/tclFileName.c
@@ -1210,7 +1210,7 @@ Tcl_GlobObjCmd(
int index, i, globFlags, length, join, dir, result;
char *string;
const char *separators;
- Tcl_Obj *typePtr, *resultPtr, *look;
+ Tcl_Obj *typePtr, *look;
Tcl_Obj *pathOrDir = NULL;
Tcl_DString prefix;
static const char *const options[] = {
@@ -1497,8 +1497,8 @@ Tcl_GlobObjCmd(
} else {
Tcl_Obj *item;
- if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK) &&
- (len == 3)) {
+ if ((Tcl_ListObjLength(NULL, look, &len) == TCL_OK)
+ && (len == 3)) {
Tcl_ListObjIndex(interp, look, 0, &item);
if (!strcmp("macintosh", Tcl_GetString(item))) {
Tcl_ListObjIndex(interp, look, 1, &item);
@@ -1528,10 +1528,9 @@ Tcl_GlobObjCmd(
*/
badTypesArg:
- TclNewObj(resultPtr);
- Tcl_AppendToObj(resultPtr, "bad argument to \"-types\": ", -1);
- Tcl_AppendObjToObj(resultPtr, look);
- Tcl_SetObjResult(interp, resultPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "bad argument to \"-types\": %s",
+ Tcl_GetString(look)));
Tcl_SetErrorCode(interp, "TCL", "ARGUMENT", "BAD", NULL);
result = TCL_ERROR;
join = 0;
@@ -1624,6 +1623,7 @@ Tcl_GlobObjCmd(
Tcl_AppendResult(interp, Tcl_DStringValue(&prefix), NULL);
} else {
const char *sep = "";
+
for (i = 0; i < objc; i++) {
string = Tcl_GetString(objv[i]);
Tcl_AppendResult(interp, sep, string, NULL);
diff --git a/generic/tclIO.c b/generic/tclIO.c
index c7fab6c..78c1dc0 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -2095,12 +2095,9 @@ Tcl_GetChannelHandle(
chanPtr = ((Channel *) chan)->state->bottomChanPtr;
if (!chanPtr->typePtr->getHandleProc) {
- Tcl_Obj *err;
-
- TclNewLiteralStringObj(err, "channel \"");
- Tcl_AppendToObj(err, Tcl_GetChannelName(chan), -1);
- Tcl_AppendToObj(err, "\" does not support OS handles", -1);
- Tcl_SetChannelError(chan, err);
+ Tcl_SetChannelError(chan, Tcl_ObjPrintf(
+ "channel \"%s\" does not support OS handles",
+ Tcl_GetChannelName(chan)));
return TCL_ERROR;
}
result = chanPtr->typePtr->getHandleProc(chanPtr->instanceData, direction,
diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c
index 683e2e4..9ba42ef 100644
--- a/generic/tclIORChan.c
+++ b/generic/tclIORChan.c
@@ -605,11 +605,9 @@ TclChanCreateObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -633,42 +631,37 @@ TclChanCreateObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
if ((mode & TCL_READABLE) && !HAS(methods, METH_READ)) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" lacks a \"read\" method", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" lacks a \"read\" method",
+ Tcl_GetString(cmdObj)));
goto error;
}
if ((mode & TCL_WRITABLE) && !HAS(methods, METH_WRITE)) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" lacks a \"write\" method", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" lacks a \"write\" method",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGET), HAS(methods, METH_CGETALL))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"cget\" but not \"cgetall\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cget\" but not \"cgetall\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_CGETALL), HAS(methods, METH_CGET))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"cgetall\" but not \"cget\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"cgetall\" but not \"cget\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c
index 5bd77b7..272306b 100644
--- a/generic/tclIORTrans.c
+++ b/generic/tclIORTrans.c
@@ -601,11 +601,9 @@ TclChanPushObjCmd(
*/
if (Tcl_ListObjGetElements(NULL, resObj, &listc, &listv) != TCL_OK) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, " initialize\" returned non-list: ", -1);
- Tcl_AppendObjToObj(err, resObj);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s initialize\" returned non-list: %s",
+ Tcl_GetString(cmdObj), Tcl_GetString(resObj)));
Tcl_DecrRefCount(resObj);
goto error;
}
@@ -629,10 +627,9 @@ TclChanPushObjCmd(
Tcl_DecrRefCount(resObj);
if ((REQUIRED_METHODS & methods) != REQUIRED_METHODS) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" does not support all required methods", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" does not support all required methods",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -652,10 +649,9 @@ TclChanPushObjCmd(
}
if (!mode) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" makes the channel inacessible", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" makes the channel inaccessible",
+ Tcl_GetString(cmdObj)));
goto error;
}
@@ -664,18 +660,16 @@ TclChanPushObjCmd(
*/
if (!IMPLIES(HAS(methods, METH_DRAIN), HAS(methods, METH_READ))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"drain\" but not \"read\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"drain\" but not \"read\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
if (!IMPLIES(HAS(methods, METH_FLUSH), HAS(methods, METH_WRITE))) {
- TclNewLiteralStringObj(err, "chan handler \"");
- Tcl_AppendObjToObj(err, cmdObj);
- Tcl_AppendToObj(err, "\" supports \"flush\" but not \"write\"", -1);
- Tcl_SetObjResult(interp, err);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "chan handler \"%s\" supports \"flush\" but not \"write\"",
+ Tcl_GetString(cmdObj)));
goto error;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index a1316d9..099b67d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2763,12 +2763,9 @@ Tcl_GetLongFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3067,12 +3064,9 @@ Tcl_GetWideIntFromObj(
}
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
@@ -3401,12 +3395,9 @@ GetBignumFromObj(
#endif
if (objPtr->typePtr == &tclDoubleType) {
if (interp != NULL) {
- Tcl_Obj *msg;
-
- TclNewLiteralStringObj(msg, "expected integer but got \"");
- Tcl_AppendObjToObj(msg, objPtr);
- Tcl_AppendToObj(msg, "\"", -1);
- Tcl_SetObjResult(interp, msg);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "expected integer but got \"%s\"",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INTEGER", NULL);
}
return TCL_ERROR;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 48f472f..50cf0f7 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -2480,7 +2480,7 @@ SetLambdaFromAny(
{
Interp *iPtr = (Interp *) interp;
const char *name;
- Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv, *errPtr;
+ Tcl_Obj *argsPtr, *bodyPtr, *nsObjPtr, **objv;
int objc, result;
Proc *procPtr;
@@ -2495,10 +2495,9 @@ SetLambdaFromAny(
result = TclListObjGetElements(NULL, objPtr, &objc, &objv);
if ((result != TCL_OK) || ((objc != 2) && (objc != 3))) {
- TclNewLiteralStringObj(errPtr, "can't interpret \"");
- Tcl_AppendObjToObj(errPtr, objPtr);
- Tcl_AppendToObj(errPtr, "\" as a lambda expression", -1);
- Tcl_SetObjResult(interp, errPtr);
+ Tcl_SetObjResult(interp, Tcl_ObjPrintf(
+ "can't interpret \"%s\" as a lambda expression",
+ Tcl_GetString(objPtr)));
Tcl_SetErrorCode(interp, "TCL", "VALUE", "LAMBDA", NULL);
return TCL_ERROR;
}
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 15bff3e..8a961ff 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1384,11 +1384,9 @@ TclParseNumber(
if (status != TCL_OK) {
if (interp != NULL) {
- Tcl_Obj *msg;
+ Tcl_Obj *msg = Tcl_ObjPrintf("expected %s but got \"",
+ expected);
- TclNewLiteralStringObj(msg, "expected ");
- Tcl_AppendToObj(msg, expected, -1);
- Tcl_AppendToObj(msg, " but got \"", -1);
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
if (state == BAD_OCTAL) {
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 55c031c..62bf1c4 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -1826,6 +1826,7 @@ TclPtrSetVar(
Tcl_Obj *oldValuePtr;
Tcl_Obj *resultPtr = NULL;
int result;
+ int cleanupOnEarlyError = (newValuePtr->refCount == 0);
/*
* If the variable is in a hashtable and its hPtr field is NULL, then we
@@ -1997,7 +1998,7 @@ TclPtrSetVar(
return resultPtr;
earlyError:
- if (newValuePtr->refCount == 0) {
+ if (cleanupOnEarlyError) {
Tcl_DecrRefCount(newValuePtr);
}
goto cleanup;
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index 3ddc3fb..922ec18 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -2253,7 +2253,16 @@ ZlibTransformClose(
ZlibChannelData *cd = instanceData;
int e, result = TCL_OK;
+ /*
+ * Delete the support timer.
+ */
+
ZlibTransformTimerKill(cd);
+
+ /*
+ * Flush any data waiting to be compressed.
+ */
+
if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) {
cd->outStream.avail_in = 0;
do {
@@ -2286,11 +2295,15 @@ ZlibTransformClose(
}
}
} while (e != Z_STREAM_END);
- e = deflateEnd(&cd->inStream);
+ e = deflateEnd(&cd->outStream);
} else {
- e = inflateEnd(&cd->outStream);
+ e = inflateEnd(&cd->inStream);
}
+ /*
+ * Release all memory.
+ */
+
if (cd->inBuffer) {
ckfree(cd->inBuffer);
cd->inBuffer = NULL;
@@ -2299,6 +2312,7 @@ ZlibTransformClose(
ckfree(cd->outBuffer);
cd->outBuffer = NULL;
}
+ ckfree(cd);
return result;
}
diff --git a/tests/assemble.test b/tests/assemble.test
index dae4821..7d4e5d1 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -30,6 +30,23 @@ proc fillTables {} {
}
return $s
}
+
+testConstraint memory [llength [info commands memory]]
+if {[testConstraint memory]} {
+ proc getbytes {} {
+ set lines [split [memory info] \n]
+ return [lindex $lines 3 3]
+ }
+ proc leaktest {script {iterations 3}} {
+ set end [getbytes]
+ for {set i 0} {$i < $iterations} {incr i} {
+ uplevel 1 $script
+ set tmp $end
+ set end [getbytes]
+ }
+ return [expr {$end - $tmp}]
+ }
+}
# assemble-1 - TclNRAssembleObjCmd
@@ -3198,6 +3215,71 @@ test assemble-50.1 {Ulam's 3n+1 problem, TAL implementation} {
}
-result {1 2 16 4 16 16 52 8 52 16 52 16 40 52 160 16 52 52 88 20 64 52 160 24 88 40 9232 52 88}
}
+
+test assemble-51.1 {memory leak testing} memory {
+ leaktest {
+ apply {{} {assemble {push hello}}}
+ }
+} 0
+test assemble-51.2 {memory leak testing} memory {
+ leaktest {
+ apply {{{x 0}} {assemble {incrImm x 1}}}
+ }
+} 0
+test assemble-51.3 {memory leak testing} memory {
+ leaktest {
+ apply {{n} {
+ assemble {
+ load n; # max
+ dup; # max n
+ jump start; # max n
+
+ label loop; # max n
+ over 1; # max n max
+ over 1; # max in max n
+ ge; # man n max>=n
+ jumpTrue skip; # max n
+
+ reverse 2; # n max
+ pop; # n
+ dup; # n n
+
+ label skip; # max n
+ dup; # max n n
+ push 2; # max n n 2
+ mod; # max n n%2
+ jumpTrue odd; # max n
+
+ push 2; # max n 2
+ div; # max n/2 -> max n
+ jump start; # max n
+
+ label odd; # max n
+ push 3; # max n 3
+ mult; # max 3*n
+ push 1; # max 3*n 1
+ add; # max 3*n+1
+
+ label start; # max n
+ dup; # max n n
+ push 1; # max n n 1
+ neq; # max n n>1
+ jumpTrue loop; # max n
+
+ pop; # max
+ }
+ }} 1
+ }
+} 0
+test assemble-51.4 {memory leak testing} memory {
+ leaktest {
+ catch {
+ apply {{} {
+ assemble {reverse polish notation}
+ }}
+ }
+ }
+} 0
rename fillTables {}
rename assemble {}
diff --git a/tests/ioTrans.test b/tests/ioTrans.test
index 3ea017b..d8defcc 100644
--- a/tests/ioTrans.test
+++ b/tests/ioTrans.test
@@ -207,7 +207,7 @@ test iortrans-2.14 {chan push, initialize failed, bad result, mode/handler misma
} -returnCodes error -cleanup {
tempdone
rename foo {}
-} -match glob -result {*makes the channel inacessible}
+} -match glob -result {*makes the channel inaccessible}
# iortrans-2.15 event/watch methods elimimated, removed these tests.
# iortrans-2.16
test iortrans-2.17 {chan push, initialize failed, bad result, drain/read mismatch} -body {
generated by cgit v0.12 at 2024-11-25 08:06:40 (GMT)