Attachment "336.patch" to
ticket [2264846fff]
added by
dgp
2008-11-12 05:25:12.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.153
diff -u -r1.153 tcl.decls
--- generic/tcl.decls 22 Oct 2008 20:23:59 -0000 1.153
+++ generic/tcl.decls 11 Nov 2008 02:49:36 -0000
@@ -2204,6 +2204,14 @@
int *objcPtr, Tcl_Obj *const *objv, Tcl_Obj ***remObjv)
}
+# TIP 335
+declare 605 generic {
+ int Tcl_GetErrorLine(Tcl_Interp *interp)
+}
+declare 606 generic {
+ void Tcl_SetErrorLine(Tcl_Interp *interp, int value)
+}
+
##############################################################################
# Define the platform specific public Tcl interface. These functions are
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.277
diff -u -r1.277 tcl.h
--- generic/tcl.h 22 Oct 2008 20:23:59 -0000 1.277
+++ generic/tcl.h 11 Nov 2008 02:49:36 -0000
@@ -476,9 +476,13 @@
char* unused3;
void (*unused4) (char*);
#endif
+#ifdef USE_INTERP_ERRORLINE
int errorLine; /* When TCL_ERROR is returned, this gives the
* line number within the command where the
* error occurred (1 if first line). */
+#else
+ int unused5;
+#endif
} Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
Index: generic/tclCmdAH.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdAH.c,v
retrieving revision 1.109
diff -u -r1.109 tclCmdAH.c
--- generic/tclCmdAH.c 26 Oct 2008 18:34:04 -0000 1.109
+++ generic/tclCmdAH.c 11 Nov 2008 02:49:36 -0000
@@ -219,7 +219,7 @@
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"%.50s\" arm line %d)",
- TclGetString(armPtr), interp->errorLine));
+ TclGetString(armPtr), Tcl_GetErrorLine(interp)));
}
return result;
}
@@ -310,7 +310,7 @@
if (rewind || Tcl_LimitExceeded(interp)) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"catch\" body line %d)", interp->errorLine));
+ "\n (\"catch\" body line %d)", Tcl_GetErrorLine(interp)));
return TCL_ERROR;
}
@@ -700,7 +700,7 @@
{
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"eval\" body line %d)", interp->errorLine));
+ "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp)));
}
return result;
}
@@ -1745,7 +1745,8 @@
Tcl_ResetResult(interp);
break;
case TCL_ERROR:
- Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(msg, interp->errorLine));
+ Tcl_AppendObjToErrorInfo(interp,
+ Tcl_ObjPrintf(msg, Tcl_GetErrorLine(interp)));
}
return result;
}
@@ -1951,7 +1952,7 @@
goto done;
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"foreach\" body line %d)", interp->errorLine));
+ "\n (\"foreach\" body line %d)", Tcl_GetErrorLine(interp)));
default:
goto done;
}
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.171
diff -u -r1.171 tclCmdMZ.c
--- generic/tclCmdMZ.c 14 Oct 2008 22:37:53 -0000 1.171
+++ generic/tclCmdMZ.c 11 Nov 2008 02:49:37 -0000
@@ -3892,7 +3892,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"%.*s%s\" arm line %d)",
(overflow ? limit : patternLength), pattern,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
TclStackFree(interp, ctxPtr);
return result;
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.155
diff -u -r1.155 tclDecls.h
--- generic/tclDecls.h 22 Oct 2008 20:23:59 -0000 1.155
+++ generic/tclDecls.h 11 Nov 2008 02:49:37 -0000
@@ -3657,6 +3657,16 @@
const Tcl_ArgvInfo * argTable, int * objcPtr,
Tcl_Obj *const * objv, Tcl_Obj *** remObjv);
#endif
+#ifndef Tcl_GetErrorLine_TCL_DECLARED
+#define Tcl_GetErrorLine_TCL_DECLARED
+/* 605 */
+EXTERN int Tcl_GetErrorLine (Tcl_Interp * interp);
+#endif
+#ifndef Tcl_SetErrorLine_TCL_DECLARED
+#define Tcl_SetErrorLine_TCL_DECLARED
+/* 606 */
+EXTERN void Tcl_SetErrorLine (Tcl_Interp * interp, int value);
+#endif
typedef struct TclStubHooks {
const struct TclPlatStubs *tclPlatStubs;
@@ -4321,6 +4331,8 @@
int (*tcl_SetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj * paramList); /* 602 */
int (*tcl_GetEnsembleParameterList) (Tcl_Interp * interp, Tcl_Command token, Tcl_Obj ** paramListPtr); /* 603 */
int (*tcl_ParseArgsObjv) (Tcl_Interp * interp, const Tcl_ArgvInfo * argTable, int * objcPtr, Tcl_Obj *const * objv, Tcl_Obj *** remObjv); /* 604 */
+ int (*tcl_GetErrorLine) (Tcl_Interp * interp); /* 605 */
+ void (*tcl_SetErrorLine) (Tcl_Interp * interp, int value); /* 606 */
} TclStubs;
#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
@@ -6813,6 +6825,14 @@
#define Tcl_ParseArgsObjv \
(tclStubsPtr->tcl_ParseArgsObjv) /* 604 */
#endif
+#ifndef Tcl_GetErrorLine
+#define Tcl_GetErrorLine \
+ (tclStubsPtr->tcl_GetErrorLine) /* 605 */
+#endif
+#ifndef Tcl_SetErrorLine
+#define Tcl_SetErrorLine \
+ (tclStubsPtr->tcl_SetErrorLine) /* 606 */
+#endif
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
Index: generic/tclDictObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDictObj.c,v
retrieving revision 1.69
diff -u -r1.69 tclDictObj.c
--- generic/tclDictObj.c 15 Oct 2008 06:17:04 -0000 1.69
+++ generic/tclDictObj.c 11 Nov 2008 02:49:38 -0000
@@ -2509,7 +2509,8 @@
result = TCL_OK;
} else if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"dict for\" body line %d)", interp->errorLine));
+ "\n (\"dict for\" body line %d)",
+ Tcl_GetErrorLine(interp)));
}
goto done;
}
@@ -2905,7 +2906,7 @@
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"dict filter\" script line %d)",
- interp->errorLine));
+ Tcl_GetErrorLine(interp)));
default:
goto abnormalResult;
}
Index: generic/tclIOUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIOUtil.c,v
retrieving revision 1.158
diff -u -r1.158 tclIOUtil.c
--- generic/tclIOUtil.c 5 Oct 2008 22:25:35 -0000 1.158
+++ generic/tclIOUtil.c 11 Nov 2008 02:49:38 -0000
@@ -1781,7 +1781,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (file \"%.*s%s\" line %d)",
(overflow ? limit : length), pathString,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
end:
Index: generic/tclNamesp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclNamesp.c,v
retrieving revision 1.181
diff -u -r1.181 tclNamesp.c
--- generic/tclNamesp.c 7 Nov 2008 20:10:19 -0000 1.181
+++ generic/tclNamesp.c 11 Nov 2008 02:49:39 -0000
@@ -3375,7 +3375,7 @@
"\n (in namespace %s \"%.*s%s\" script line %d)",
cmd,
(overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
Index: generic/tclOOBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOBasic.c,v
retrieving revision 1.15
diff -u -r1.15 tclOOBasic.c
--- generic/tclOOBasic.c 1 Nov 2008 00:04:26 -0000 1.15
+++ generic/tclOOBasic.c 11 Nov 2008 02:49:39 -0000
@@ -358,11 +358,11 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (in \"%s eval\" script line %d)",
- TclGetString(objnameObj), interp->errorLine));
+ TclGetString(objnameObj), Tcl_GetErrorLine(interp)));
} else {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (in \"my eval\" script line %d)",
- interp->errorLine));
+ Tcl_GetErrorLine(interp)));
}
}
@@ -1010,7 +1010,7 @@
iPtr->varFramePtr = savedFramePtr;
if (rewind || Tcl_LimitExceeded(interp)) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"UpCatch\" body line %d)", interp->errorLine));
+ "\n (\"UpCatch\" body line %d)", Tcl_GetErrorLine(interp)));
return TCL_ERROR;
}
resultObj[0] = Tcl_GetObjResult(interp);
Index: generic/tclOODefineCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOODefineCmds.c,v
retrieving revision 1.7
diff -u -r1.7 tclOODefineCmds.c
--- generic/tclOODefineCmds.c 31 Oct 2008 22:08:32 -0000 1.7
+++ generic/tclOODefineCmds.c 11 Nov 2008 02:49:39 -0000
@@ -706,7 +706,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (in definition script for object \"%.*s%s\" line %d)",
(overflow ? limit : length), objName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
@@ -825,7 +825,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (in definition script for object \"%.*s%s\" line %d)",
(overflow ? limit : length), objName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
@@ -945,7 +945,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (in definition script for object \"%.*s%s\" line %d)",
(overflow ? limit : length), objName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
} else {
Tcl_Obj *objPtr, *obj2Ptr, **objs;
Index: generic/tclOOMethod.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclOOMethod.c,v
retrieving revision 1.20
diff -u -r1.20 tclOOMethod.c
--- generic/tclOOMethod.c 24 Sep 2008 09:51:47 -0000 1.20
+++ generic/tclOOMethod.c 11 Nov 2008 02:49:39 -0000
@@ -1173,7 +1173,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (%s \"%.*s%s\" method \"%.*s%s\" line %d)",
kindName, ELLIPSIFY(objectName, objectNameLen),
- ELLIPSIFY(methodName, nameLen), interp->errorLine));
+ ELLIPSIFY(methodName, nameLen), Tcl_GetErrorLine(interp)));
}
static void
@@ -1187,7 +1187,7 @@
const char *objectName, *kindName;
int objectNameLen;
- if (interp->errorLine == (int) 0xDEADBEEF) {
+ if (Tcl_GetErrorLine(interp) == (int) 0xDEADBEEF) {
/*
* Horrible hack to deal with certain constructors that must not add
* information to the error trace.
@@ -1211,7 +1211,7 @@
&objectNameLen);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (%s \"%.*s%s\" constructor line %d)", kindName,
- ELLIPSIFY(objectName, objectNameLen), interp->errorLine));
+ ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}
static void
@@ -1240,7 +1240,7 @@
&objectNameLen);
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (%s \"%.*s%s\" destructor line %d)", kindName,
- ELLIPSIFY(objectName, objectNameLen), interp->errorLine));
+ ELLIPSIFY(objectName, objectNameLen), Tcl_GetErrorLine(interp)));
}
/*
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.167
diff -u -r1.167 tclProc.c
--- generic/tclProc.c 28 Oct 2008 23:29:54 -0000 1.167
+++ generic/tclProc.c 11 Nov 2008 02:49:39 -0000
@@ -903,7 +903,7 @@
if (result == TCL_ERROR) {
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
- "\n (\"uplevel\" body line %d)", interp->errorLine));
+ "\n (\"uplevel\" body line %d)", Tcl_GetErrorLine(interp)));
}
/*
@@ -2091,7 +2091,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (procedure \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
@@ -2783,7 +2783,7 @@
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (lambda term \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
Index: generic/tclResult.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclResult.c,v
retrieving revision 1.51
diff -u -r1.51 tclResult.c
--- generic/tclResult.c 26 Oct 2008 18:34:04 -0000 1.51
+++ generic/tclResult.c 11 Nov 2008 02:49:40 -0000
@@ -1084,6 +1084,45 @@
/*
*----------------------------------------------------------------------
*
+ * Tcl_GetErrorLine --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_GetErrorLine(
+ Tcl_Interp *interp)
+{
+ return ((Interp *) interp)->errorLine;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetErrorLine --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetErrorLine(
+ Tcl_Interp *interp,
+ int value)
+{
+ ((Interp *) interp)->errorLine = value;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* GetKeys --
*
* Returns a Tcl_Obj * array of the standard keys used in the return
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.167
diff -u -r1.167 tclStubInit.c
--- generic/tclStubInit.c 22 Oct 2008 20:23:59 -0000 1.167
+++ generic/tclStubInit.c 11 Nov 2008 02:49:40 -0000
@@ -1130,6 +1130,8 @@
Tcl_SetEnsembleParameterList, /* 602 */
Tcl_GetEnsembleParameterList, /* 603 */
Tcl_ParseArgsObjv, /* 604 */
+ Tcl_GetErrorLine, /* 605 */
+ Tcl_SetErrorLine, /* 606 */
};
/* !END!: Do not edit above this line. */
