Attachment "inner9b.patch" to
ticket [2995655fff]
added by
ferrieux
2010-10-18 03:03:37.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.467
diff -u -p -r1.467 tclBasic.c
--- generic/tclBasic.c 1 Oct 2010 12:52:49 -0000 1.467
+++ generic/tclBasic.c 17 Oct 2010 20:00:24 -0000
@@ -549,6 +549,10 @@ Tcl_CreateInterp(void)
Tcl_IncrRefCount(iPtr->upLiteral);
TclNewLiteralStringObj(iPtr->callLiteral,"CALL");
Tcl_IncrRefCount(iPtr->callLiteral);
+ TclNewLiteralStringObj(iPtr->innerLiteral,"INNER");
+ Tcl_IncrRefCount(iPtr->innerLiteral);
+ iPtr->innerContext = Tcl_NewListObj(0, NULL);
+ Tcl_IncrRefCount(iPtr->innerContext);
iPtr->errorCode = NULL;
TclNewLiteralStringObj(iPtr->ecVar, "::errorCode");
Tcl_IncrRefCount(iPtr->ecVar);
@@ -1492,6 +1496,8 @@ DeleteInterpProc(
iPtr->errorStack = NULL;
Tcl_DecrRefCount(iPtr->upLiteral);
Tcl_DecrRefCount(iPtr->callLiteral);
+ Tcl_DecrRefCount(iPtr->innerLiteral);
+ Tcl_DecrRefCount(iPtr->innerContext);
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.169
diff -u -p -r1.169 tclCompCmds.c
--- generic/tclCompCmds.c 30 Apr 2010 09:23:06 -0000 1.169
+++ generic/tclCompCmds.c 17 Oct 2010 20:00:27 -0000
@@ -3613,6 +3613,7 @@ TclCompileSyntaxError(
int numBytes;
const char *bytes = TclGetStringFromObj(msg, &numBytes);
+ TclErrorStackResetIf(interp, bytes, numBytes);
TclEmitPush(TclRegisterNewLiteral(envPtr, bytes, numBytes), envPtr);
CompileReturnInternal(envPtr, INST_SYNTAX, TCL_ERROR, 0,
Tcl_GetReturnOptions(interp, TCL_ERROR));
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.191
diff -u -p -r1.191 tclCompile.c
--- generic/tclCompile.c 13 Oct 2010 17:10:57 -0000 1.191
+++ generic/tclCompile.c 17 Oct 2010 20:00:31 -0000
@@ -450,6 +450,8 @@ static int FormatInstruction(ByteCode *
const unsigned char *pc, Tcl_Obj *bufferObj);
static void PrintSourceToObj(Tcl_Obj *appendObj,
const char *stringPtr, int maxChars);
+static void UpdateStringOfInstName(Tcl_Obj *objPtr);
+
/*
* TIP #280: Helper for building the per-word line information of all compiled
* commands.
@@ -484,6 +486,19 @@ static const Tcl_ObjType substCodeType =
NULL, /* updateStringProc */
NULL, /* setFromAnyProc */
};
+
+/*
+ * The structure below defines an instruction name Tcl object to allow
+ * reporting of inner contexts in errorstack without string allocation.
+ */
+
+static const Tcl_ObjType tclInstNameType = {
+ "instname", /* name */
+ NULL, /* freeIntRepProc */
+ NULL, /* dupIntRepProc */
+ UpdateStringOfInstName, /* updateStringProc */
+ NULL, /* setFromAnyProc */
+};
/*
*----------------------------------------------------------------------
@@ -4236,6 +4251,165 @@ FormatInstruction(
/*
*----------------------------------------------------------------------
*
+ * TclGetInnerContext --
+ *
+ * If possible, returns a list capturing the inner context. Otherwise
+ * return NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
+ const unsigned char *pc,
+ Tcl_Obj **tosPtr)
+{
+ int objc = 0, off = 0;
+ Tcl_Obj *result;
+ Interp *iPtr = (Interp *) interp;
+
+ switch(*pc) {
+
+ case INST_STR_LEN:
+ case INST_LNOT:
+ case INST_BITNOT:
+ case INST_UMINUS:
+ case INST_UPLUS:
+ case INST_TRY_CVT_TO_NUMERIC:
+ case INST_EXPAND_STKTOP:
+ case INST_EXPR_STK:
+
+ objc = 1;
+ break;
+
+ case INST_LIST_IN:
+ case INST_LIST_NOT_IN: /* Basic list containment operators. */
+ case INST_STR_EQ:
+ case INST_STR_NEQ: /* String (in)equality check */
+ case INST_STR_CMP: /* String compare. */
+ case INST_STR_INDEX:
+ case INST_STR_MATCH:
+ case INST_REGEXP:
+ case INST_EQ:
+ case INST_NEQ:
+ case INST_LT:
+ case INST_GT:
+ case INST_LE:
+ case INST_GE:
+ case INST_MOD:
+ case INST_LSHIFT:
+ case INST_RSHIFT:
+ case INST_BITOR:
+ case INST_BITXOR:
+ case INST_BITAND:
+ case INST_EXPON:
+ case INST_ADD:
+ case INST_SUB:
+ case INST_DIV:
+ case INST_MULT:
+ objc = 2;
+ break;
+
+ case INST_RETURN_STK:
+ /* early pop. TODO: dig out opt dict too :/ */
+ objc = 1;
+ break;
+
+ case INST_SYNTAX:
+ case INST_RETURN_IMM:
+ objc = 2;
+ break;
+
+ case INST_INVOKE_STK4:
+ objc = TclGetUInt4AtPtr(pc+1);
+ break;
+
+ case INST_INVOKE_STK1:
+ objc = TclGetUInt1AtPtr(pc+1);
+ break;
+ }
+
+ result = iPtr->innerContext;
+ if (Tcl_IsShared(result)) {
+ Tcl_DecrRefCount(result);
+ iPtr->innerContext = result = Tcl_NewListObj(objc + 1, NULL);
+ Tcl_IncrRefCount(result);
+ } else {
+ int len;
+
+ Tcl_ListObjLength(interp, result, &len);
+ /* reset while keeping the list intrep as much as possible */
+ Tcl_ListObjReplace(interp, result, 0, len, 0, NULL);
+ }
+ Tcl_ListObjAppendElement(NULL, result, TclNewInstNameObj(*pc));
+ for(;objc>0;objc--) {
+ Tcl_Obj *ob;
+
+ ob = tosPtr[1 - objc + off];
+ if (!ob) {
+ Tcl_Panic("InnerContext: bad tos -- appending null object");
+ }
+ if (ob->refCount<=0 || ob->refCount==0x61616161) {
+ Tcl_Panic("InnerContext: bad tos -- appending freed object %p",ob);
+ }
+ Tcl_ListObjAppendElement(NULL, result, ob);
+ }
+
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclNewInstNameObj --
+ *
+ * Creates a new InstName Tcl_Obj based on the given instruction
+ *
+ *----------------------------------------------------------------------
+ */
+MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst)
+{
+ Tcl_Obj *objPtr;
+
+ objPtr=Tcl_NewObj();
+ objPtr->typePtr = &tclInstNameType;
+ objPtr->internalRep.longValue = (long)inst;
+ objPtr->bytes = NULL;
+
+ return objPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfInstName --
+ *
+ * Update the string representation for an instruction name object.
+ *
+ *----------------------------------------------------------------------
+ */
+static void UpdateStringOfInstName(Tcl_Obj *objPtr)
+{
+ int inst = objPtr->internalRep.longValue;
+ char *s,buf[20];
+ int len;
+
+ if ((inst < 0) || (inst > LAST_INST_OPCODE)) {
+
+ sprintf(buf, "inst_%d", inst);
+ s = buf;
+ } else {
+ s = (char *)tclInstructionTable[objPtr->internalRep.longValue].name;
+ }
+ len = strlen(s);
+ objPtr->bytes = ckalloc((unsigned) len + 1);
+ strcpy(objPtr->bytes, s);
+ objPtr->length = len;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
* PrintSourceToObj --
*
* Appends a quoted representation of a string to a Tcl_Obj.
@@ -4341,5 +4515,7 @@ RecordByteCodeStats(
* mode: c
* c-basic-offset: 4
* fill-column: 78
+ * tab-width: 8
+ * indent-tabs-mode: nil
* End:
*/
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.127
diff -u -p -r1.127 tclCompile.h
--- generic/tclCompile.h 27 Sep 2010 19:42:38 -0000 1.127
+++ generic/tclCompile.h 17 Oct 2010 20:00:33 -0000
@@ -975,6 +975,14 @@ MODULE_SCOPE void TclVerifyLocalLiteralT
#endif
MODULE_SCOPE int TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
Tcl_Obj *valuePtr);
+MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp,
+ const char *script,
+ const char *command, int length,
+ const unsigned char *pc, Tcl_Obj **tosPtr);
+MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp,
+ const unsigned char *pc, Tcl_Obj **tosPtr);
+MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst);
+
/*
*----------------------------------------------------------------
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.507
diff -u -p -r1.507 tclExecute.c
--- generic/tclExecute.c 16 Oct 2010 20:27:39 -0000 1.507
+++ generic/tclExecute.c 17 Oct 2010 20:00:47 -0000
@@ -697,7 +697,8 @@ static void FreeExprCodeInternalRep(Tcl
static ExceptionRange * GetExceptRangeForPc(const unsigned char *pc,
int catchOnly, ByteCode *codePtr);
static const char * GetSrcInfoForPc(const unsigned char *pc,
- ByteCode *codePtr, int *lengthPtr);
+ ByteCode *codePtr, int *lengthPtr,
+ const unsigned char **pcBeg);
static Tcl_Obj ** GrowEvaluationStack(ExecEnv *eePtr, int growth,
int move);
static void IllegalExprOperandType(Tcl_Interp *interp,
@@ -2445,7 +2446,7 @@ TEBCresume(
}
codePtr->flags |= TCL_BYTECODE_RECOMPILE;
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, NULL);
opnd = TclGetUInt4AtPtr(pc+1);
pc += (opnd-1);
PUSH_OBJECT(Tcl_NewStringObj(bytes, length));
@@ -6259,9 +6260,11 @@ TEBCresume(
goto abnormalReturn;
}
if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ const unsigned char *pcBeg;
+
+ bytes = GetSrcInfoForPc(pc, codePtr, &length, &pcBeg);
DECACHE_STACK_INFO();
- Tcl_LogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0);
+ TclLogCommandInfo(interp, codePtr->source, bytes, bytes ? length : 0, pcBeg, tosPtr);
CACHE_STACK_INFO();
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -7894,7 +7897,7 @@ ValidatePcAndStackTop(
if (checkStack &&
((stackTop < stackLowerBound) || (stackTop > stackUpperBound))) {
int numChars;
- const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars);
+ const char *cmd = GetSrcInfoForPc(pc, codePtr, &numChars, NULL);
fprintf(stderr, "\nBad stack top %d at pc %u in TclNRExecuteByteCode (min %i, max %i)",
stackTop, relativePc, stackLowerBound, stackUpperBound);
@@ -8008,7 +8011,7 @@ TclGetSrcInfoForCmd(
ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr;
return GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc,
- codePtr, lenPtr);
+ codePtr, lenPtr, NULL);
}
void
@@ -8020,7 +8023,7 @@ TclGetSrcInfoForPc(
if (cfPtr->cmd.str.cmd == NULL) {
cfPtr->cmd.str.cmd = GetSrcInfoForPc(
(unsigned char *) cfPtr->data.tebc.pc, codePtr,
- &cfPtr->cmd.str.len);
+ &cfPtr->cmd.str.len, NULL);
}
if (cfPtr->cmd.str.cmd != NULL) {
@@ -8071,15 +8074,18 @@ TclGetSrcInfoForPc(
static const char *
GetSrcInfoForPc(
- const unsigned char *pc, /* The program counter value for which to
+ const unsigned char *pc, /* The program counter value for which to
* return the closest command's source info.
- * This points to a bytecode instruction in
+ * This points within a bytecode instruction in
* codePtr's code. */
ByteCode *codePtr, /* The bytecode sequence in which to look up
* the command source for the pc. */
- int *lengthPtr) /* If non-NULL, the location where the length
+ int *lengthPtr, /* If non-NULL, the location where the length
* of the command's source should be stored.
* If NULL, no length is stored. */
+ const unsigned char **pcBeg)/* If non-NULL, the bytecode location
+ * where the current instruction starts.
+ * If NULL; no pointer is stored. */
{
register int pcOffset = (pc - codePtr->codeStart);
int numCmds = codePtr->numCommands;
@@ -8091,6 +8097,7 @@ GetSrcInfoForPc(
int bestSrcLength = -1; /* Initialized to avoid compiler warning. */
if ((pcOffset < 0) || (pcOffset >= codePtr->numCodeBytes)) {
+ if (pcBeg != NULL) *pcBeg = NULL;
return NULL;
}
@@ -8159,6 +8166,22 @@ GetSrcInfoForPc(
}
}
+ if (pcBeg != NULL) {
+ const unsigned char *curr,*prev;
+
+ /* Walk from beginning of command or BC to pc, by complete
+ * instructions. Stop when crossing pc; keep previous */
+
+ curr = prev = ((bestDist == INT_MAX) ?
+ codePtr->codeStart :
+ pc - bestDist);
+ while (curr <= pc) {
+ prev = curr;
+ curr += tclInstructionTable[*curr].numBytes;
+ }
+ *pcBeg = prev ;
+ }
+
if (bestDist == INT_MAX) {
return NULL;
}
@@ -8166,6 +8189,7 @@ GetSrcInfoForPc(
if (lengthPtr != NULL) {
*lengthPtr = bestSrcLength;
}
+
return (codePtr->source + bestSrcOffset);
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.484
diff -u -p -r1.484 tclInt.h
--- generic/tclInt.h 28 Sep 2010 15:13:54 -0000 1.484
+++ generic/tclInt.h 17 Oct 2010 20:00:48 -0000
@@ -2159,6 +2159,8 @@ typedef struct Interp {
Tcl_Obj *errorStack; /* [info errorstack] value (as a Tcl_Obj). */
Tcl_Obj *upLiteral; /* "UP" literal for [info errorstack] */
Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */
+ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */
+ Tcl_Obj *innerContext; /* cached list for fast reallocation */
int resetErrorStack; /* controls cleaning up of ::errorStack */
#ifdef TCL_COMPILE_STATS
@@ -3099,6 +3101,8 @@ MODULE_SCOPE void TclpThreadDeleteKey(vo
MODULE_SCOPE void TclpThreadSetMasterTSD(void *tsdKeyPtr, void *ptr);
MODULE_SCOPE void * TclpThreadGetMasterTSD(void *tsdKeyPtr);
+MODULE_SCOPE void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length);
+
/*
*----------------------------------------------------------------
* Command procedures in the generic core:
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.213
diff -u -p -r1.213 tclNamesp.c
--- generic/tclNamesp.c 1 Oct 2010 12:52:49 -0000 1.213
+++ generic/tclNamesp.c 17 Oct 2010 20:00:51 -0000
@@ -26,7 +26,7 @@
*/
#include "tclInt.h"
-#include "tclCompile.h" /* just for NRCommand */
+#include "tclCompile.h" /* for NRCommand; and TclLogCommandInfo visibility */
/*
* Thread-local storage used to avoid having a global lock on data that is not
@@ -4851,31 +4851,36 @@ TclGetNamespaceChildTable(
/*
*----------------------------------------------------------------------
*
- * Tcl_LogCommandInfo --
+ * TclLogCommandInfo --
*
* This function is invoked after an error occurs in an interpreter. It
- * adds information to iPtr->errorInfo field to describe the command that
- * was being executed when the error occurred.
+ * adds information to iPtr->errorInfo/errorStack fields to describe the
+ * command that was being executed when the error occurred. When pc and
+ * tosPtr are non-NULL, conveying a bytecode execution "inner context",
+ * and the offending instruction is suitable, that inner context is
+ * recorded in errorStack.
*
* Results:
* None.
*
* Side effects:
- * Information about the command is added to errorInfo and the line
- * number stored internally in the interpreter is set.
+ * Information about the command is added to errorInfo/errorStack and the
+ * line number stored internally in the interpreter is set.
*
*----------------------------------------------------------------------
*/
void
-Tcl_LogCommandInfo(
+TclLogCommandInfo(
Tcl_Interp *interp, /* Interpreter in which to log information. */
const char *script, /* First character in script containing
* command (must be <= command). */
const char *command, /* First character in command that generated
* the error. */
- int length) /* Number of bytes in command (-1 means use
+ int length, /* Number of bytes in command (-1 means use
* all bytes up to first null byte). */
+ const unsigned char *pc, /* current pc of bytecode execution context */
+ Tcl_Obj **tosPtr) /* current stack of bytecode execution context */
{
register const char *p;
Interp *iPtr = (Interp *) interp;
@@ -4962,6 +4967,18 @@ Tcl_LogCommandInfo(
Tcl_ListObjLength(interp, iPtr->errorStack, &len);
/* reset while keeping the list intrep as much as possible */
Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+ if (pc != NULL) {
+ Tcl_Obj *innerContext;
+
+ innerContext = TclGetInnerContext(interp, pc, tosPtr);
+ if (innerContext != NULL) {
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, innerContext);
+ }
+ } else if (command != NULL) {
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(command, length));
+ }
}
if (!iPtr->framePtr->objc) {
@@ -4981,6 +4998,80 @@ Tcl_LogCommandInfo(
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclErrorStackResetIf --
+ *
+ * The TIP 348 reset/no-bc part of TLCI, for specific use by
+ * TclCompileSyntaxError.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Reset errorstack if it needs be, and in that case remember the
+ * passed-in error message as inner context.
+ *
+ *----------------------------------------------------------------------
+ */
+void TclErrorStackResetIf(Tcl_Interp *interp, const char *msg, int length)
+{
+ Interp *iPtr = (Interp *) interp;
+
+ if (Tcl_IsShared(iPtr->errorStack)) {
+ Tcl_Obj *newObj;
+
+ newObj = Tcl_DuplicateObj(iPtr->errorStack);
+ Tcl_DecrRefCount(iPtr->errorStack);
+ Tcl_IncrRefCount(newObj);
+ iPtr->errorStack = newObj;
+ }
+ if (iPtr->resetErrorStack) {
+ int len;
+
+ iPtr->resetErrorStack = 0;
+ Tcl_ListObjLength(interp, iPtr->errorStack, &len);
+ /* reset while keeping the list intrep as much as possible */
+ Tcl_ListObjReplace(interp, iPtr->errorStack, 0, len, 0, NULL);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, iPtr->innerLiteral);
+ Tcl_ListObjAppendElement(NULL, iPtr->errorStack, Tcl_NewStringObj(msg, length));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LogCommandInfo --
+ *
+ * This function is invoked after an error occurs in an interpreter. It
+ * adds information to iPtr->errorInfo/errorStack fields to describe the
+ * command that was being executed when the error occurred.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the command is added to errorInfo/errorStack and the
+ * line number stored internally in the interpreter is set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_LogCommandInfo(
+ Tcl_Interp *interp, /* Interpreter in which to log information. */
+ const char *script, /* First character in script containing
+ * command (must be <= command). */
+ const char *command, /* First character in command that generated
+ * the error. */
+ int length) /* Number of bytes in command (-1 means use
+ * all bytes up to first null byte). */
+{
+ TclLogCommandInfo(interp, script, command, length, NULL, NULL);
+}
+
+
+/*
* Local Variables:
* mode: c
* c-basic-offset: 4
Index: tests/error.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/error.test,v
retrieving revision 1.33
diff -u -p -r1.33 error.test
--- tests/error.test 2 Jun 2010 23:36:26 -0000 1.33
+++ tests/error.test 17 Oct 2010 20:00:54 -0000
@@ -174,13 +174,13 @@ test error-4.6 {errorstack via info } -b
proc g x {error G:$x}
catch {f 12}
info errorstack
-} -match glob -result {CALL {g 1212} CALL {f 12} UP 1}
+} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
test error-4.7 {errorstack via options dict } -body {
proc f x {g $x$x}
proc g x {error G:$x}
catch {f 12} m d
dict get $d -errorstack
-} -match glob -result {CALL {g 1212} CALL {f 12} UP 1}
+} -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1}
# Errors in error command itself
@@ -244,7 +244,7 @@ test error-6.10 {catch must reset errors
catch {f 13}
set e2 [info errorstack]
list $e1 $e2
-} -match glob -result {{CALL {g 1212} CALL {f 12} UP 1} {CALL {g 1313} CALL {f 13} UP 1}}
+} -match glob -result {{INNER * CALL {g 1212} CALL {f 12} UP 1} {INNER * CALL {g 1313} CALL {f 13} UP 1}}
test error-7.1 {Bug 1397843} -body {
variable cmds
Index: tests/result.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/result.test,v
retrieving revision 1.19
diff -u -p -r1.19 result.test
--- tests/result.test 2 Jun 2010 23:36:26 -0000 1.19
+++ tests/result.test 17 Oct 2010 20:00:54 -0000
@@ -135,14 +135,14 @@ test result-6.3 {Bug 2383005} {
catch {return -code error -errorcode {{}a} eek} m
set m
} {bad -errorcode value: expected a list but got "{}a"}
-test result-6.4 {non-list -errorstack} {
+test result-6.4 {non-list -errorstack} -body {
catch {return -code error -errorstack {{}a} eek} m o
list $m [dict get $o -errorcode] [dict get $o -errorstack]
-} {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {UP 1}}
-test result-6.5 {odd-sized-list -errorstack} {
+} -match glob -result {{bad -errorstack value: expected a list but got "{}a"} {TCL RESULT NONLIST_ERRORSTACK} {INNER * UP 1}}
+test result-6.5 {odd-sized-list -errorstack} -body {
catch {return -code error -errorstack a eek} m o
list $m [dict get $o -errorcode] [dict get $o -errorstack]
-} {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {UP 1}}
+} -match glob -result {{forbidden odd-sized list for -errorstack: "a"} {TCL RESULT ODDSIZEDLIST_ERRORSTACK} {INNER * UP 1}}
# cleanup
cleanupTests
return
