summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls10
-rw-r--r--generic/tcl.h6
-rw-r--r--generic/tclCmdAH.c13
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--generic/tclDecls.h22
-rw-r--r--generic/tclDictObj.c7
-rw-r--r--generic/tclIOUtil.c4
-rw-r--r--generic/tclNamesp.c4
-rw-r--r--generic/tclOOBasic.c8
-rw-r--r--generic/tclOODefineCmds.c8
-rw-r--r--generic/tclOOMethod.c10
-rw-r--r--generic/tclProc.c8
-rw-r--r--generic/tclResult.c41
-rw-r--r--generic/tclStubInit.c4
14 files changed, 112 insertions, 37 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls
index 715c2ad..b294b91 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -12,7 +12,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tcl.decls,v 1.154 2008/11/17 22:15:34 nijtmans Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.155 2008/12/02 19:40:40 dgp Exp $
library tcl
@@ -2204,6 +2204,14 @@ declare 604 generic {
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
diff --git a/generic/tcl.h b/generic/tcl.h
index 5354a70..c99ad44 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -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: tcl.h,v 1.279 2008/11/27 08:23:51 ferrieux Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.280 2008/12/02 19:40:41 dgp Exp $
*/
#ifndef _TCL
@@ -476,9 +476,13 @@ typedef struct Tcl_Interp {
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;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 19ef57e..ead9384 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdAH.c,v 1.110 2008/11/29 18:17:20 dkf Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.111 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -221,7 +221,7 @@ Tcl_CaseObjCmd(
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;
}
@@ -312,7 +312,7 @@ CatchObjCmdCallback(
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;
}
@@ -702,7 +702,7 @@ EvalCmdErrMsg(
{
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;
}
@@ -1894,7 +1894,8 @@ TclNRForIterCallback(
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;
}
@@ -2100,7 +2101,7 @@ ForeachLoopStep(
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;
}
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 794b75b..c42370c 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -15,7 +15,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.171 2008/10/14 22:37:53 nijtmans Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.172 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -3892,7 +3892,7 @@ Tcl_SwitchObjCmd(
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;
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 2578df2..f75b63e 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDecls.h,v 1.156 2008/11/17 22:15:34 nijtmans Exp $
+ * RCS: @(#) $Id: tclDecls.h,v 1.157 2008/12/02 19:40:41 dgp Exp $
*/
#ifndef _TCLDECLS
@@ -3657,6 +3657,16 @@ EXTERN int Tcl_ParseArgsObjv (Tcl_Interp * interp,
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 @@ typedef struct TclStubs {
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 @@ extern const TclStubs *tclStubsPtr;
#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) */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 75e1478..bcdc404 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -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: tclDictObj.c,v 1.70 2008/11/17 22:15:34 nijtmans Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.71 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -2508,7 +2508,8 @@ DictForLoopCallback(
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;
}
@@ -2904,7 +2905,7 @@ DictFilterCmd(
case TCL_ERROR:
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (\"dict filter\" script line %d)",
- interp->errorLine));
+ Tcl_GetErrorLine(interp)));
default:
goto abnormalResult;
}
diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c
index 607397e..7b6a4c8 100644
--- a/generic/tclIOUtil.c
+++ b/generic/tclIOUtil.c
@@ -17,7 +17,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclIOUtil.c,v 1.159 2008/11/13 22:34:33 nijtmans Exp $
+ * RCS: @(#) $Id: tclIOUtil.c,v 1.160 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -1775,7 +1775,7 @@ Tcl_FSEvalFileEx(
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (file \"%.*s%s\" line %d)",
(overflow ? limit : length), pathString,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
end:
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index a88d140..3703118 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -23,7 +23,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.182 2008/11/11 21:54:06 nijtmans Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.183 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -3375,7 +3375,7 @@ NsEval_Callback(
"\n (in namespace %s \"%.*s%s\" script line %d)",
cmd,
(overflow ? limit : length), namespacePtr->fullName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c
index b52f90c..887e80c 100644
--- a/generic/tclOOBasic.c
+++ b/generic/tclOOBasic.c
@@ -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: tclOOBasic.c,v 1.15 2008/11/01 00:04:26 dkf Exp $
+ * RCS: @(#) $Id: tclOOBasic.c,v 1.16 2008/12/02 19:40:41 dgp Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -358,11 +358,11 @@ FinalizeEval(
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 @@ UpcatchCallback(
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);
diff --git a/generic/tclOODefineCmds.c b/generic/tclOODefineCmds.c
index a96d267..5b1f354 100644
--- a/generic/tclOODefineCmds.c
+++ b/generic/tclOODefineCmds.c
@@ -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: tclOODefineCmds.c,v 1.7 2008/10/31 22:08:32 dkf Exp $
+ * RCS: @(#) $Id: tclOODefineCmds.c,v 1.8 2008/12/02 19:40:41 dgp Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -706,7 +706,7 @@ TclOODefineObjCmd(
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 @@ TclOOObjDefObjCmd(
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 @@ TclOODefineSelfObjCmd(
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;
diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c
index 34a3172..2606f0a 100644
--- a/generic/tclOOMethod.c
+++ b/generic/tclOOMethod.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclOOMethod.c,v 1.20 2008/09/24 09:51:47 dkf Exp $
+ * RCS: @(#) $Id: tclOOMethod.c,v 1.21 2008/12/02 19:40:41 dgp Exp $
*/
#ifdef HAVE_CONFIG_H
@@ -1173,7 +1173,7 @@ MethodErrorHandler(
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 @@ ConstructorErrorHandler(
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 @@ ConstructorErrorHandler(
&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 @@ DestructorErrorHandler(
&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)));
}
/*
diff --git a/generic/tclProc.c b/generic/tclProc.c
index a7e9531..80c792c 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclProc.c,v 1.167 2008/10/28 23:29:54 nijtmans Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.168 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -903,7 +903,7 @@ Uplevel_Callback(
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 @@ MakeProcError(
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 @@ MakeLambdaError(
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (lambda term \"%.*s%s\" line %d)",
(overflow ? limit : nameLen), procName,
- (overflow ? "..." : ""), interp->errorLine));
+ (overflow ? "..." : ""), Tcl_GetErrorLine(interp)));
}
/*
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 40f0cba..8e85035 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclResult.c,v 1.51 2008/10/26 18:34:04 dkf Exp $
+ * RCS: @(#) $Id: tclResult.c,v 1.52 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -1084,6 +1084,45 @@ Tcl_SetObjErrorCode(
/*
*----------------------------------------------------------------------
*
+ * 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
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index a95f056..15cfa2d 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.167 2008/10/22 20:23:59 nijtmans Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.168 2008/12/02 19:40:41 dgp Exp $
*/
#include "tclInt.h"
@@ -1130,6 +1130,8 @@ static const TclStubs tclStubs = {
Tcl_SetEnsembleParameterList, /* 602 */
Tcl_GetEnsembleParameterList, /* 603 */
Tcl_ParseArgsObjv, /* 604 */
+ Tcl_GetErrorLine, /* 605 */
+ Tcl_SetErrorLine, /* 606 */
};
/* !END!: Do not edit above this line. */
generated by cgit v0.12 at 2024-12-04 23:10:53 (GMT)