summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2005-09-14 03:46:50 (GMT)
committerdgp <dgp@users.sourceforge.net>2005-09-14 03:46:50 (GMT)
commitd6a5a988b1a1360a77a043ec10d175c8a6c0fd36 (patch)
tree5488ff4bffc012fb31318be36a9b541fe2419992
parentc483a47557d64385bc3cc9f65aedf8b6bf387843 (diff)
downloadtcl-d6a5a988b1a1360a77a043ec10d175c8a6c0fd36.zip
tcl-d6a5a988b1a1360a77a043ec10d175c8a6c0fd36.tar.gz
tcl-d6a5a988b1a1360a77a043ec10d175c8a6c0fd36.tar.bz2
* generic/tclBasic.c: First caller of TclFormatToErrorInfo.
* generic/tclInt.h: Using stdarg.h conventions, add more * generic/tclStringObj.c: fixed arguments to TclFormatObj() and TclObjPrintf(). Added new routine TclFormatToErrorInfo().
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c21
-rw-r--r--generic/tclInt.h10
-rw-r--r--generic/tclStringObj.c85
4 files changed, 67 insertions, 55 deletions
diff --git a/ChangeLog b/ChangeLog
index e4edf8b..7ca05b0 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
2005-09-13 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c: First caller of TclFormatToErrorInfo.
+
+ * generic/tclInt.h: Using stdarg.h conventions, add more
+ * generic/tclStringObj.c: fixed arguments to TclFormatObj() and
+ TclObjPrintf(). Added new routine TclFormatToErrorInfo().
+
* generic/tcl.h: Explicitly standardized on the use of stdarg.h
* generic/tclBasic.c: conventions for functions with variable number
* generic/tclInt.h: of arguments. Support for varargs.h has been
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7266c08..a038550 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.170 2005/09/13 21:23:51 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.171 2005/09/14 03:46:50 dgp Exp $
*/
#include "tclInt.h"
@@ -3769,22 +3769,9 @@ Tcl_EvalEx(interp, script, numBytes, flags)
code = Tcl_ListObjLength(interp,
objv[objectsUsed], &numElements);
if (code == TCL_ERROR) {
- /*
- * Attempt to expand a non-list.
- */
-
- Tcl_Obj *msg;
- Tcl_Obj *wordNum;
-
- msg = Tcl_NewStringObj("\n (expanding word ", -1);
- TclNewIntObj(wordNum, objectsUsed);
- Tcl_IncrRefCount(wordNum);
- Tcl_IncrRefCount(msg);
- Tcl_AppendObjToObj(msg, wordNum);
- Tcl_DecrRefCount(wordNum);
- Tcl_AppendToObj(msg, ")", -1);
- TclAppendObjToErrorInfo(interp, msg);
- Tcl_DecrRefCount(msg);
+ /* Attempt to expand a non-list. */
+ TclFormatToErrorInfo(interp,
+ "\n (expanding word %d)", objectsUsed);
Tcl_DecrRefCount(objv[objectsUsed]);
goto error;
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 43d12c7..b810845 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.251 2005/09/13 21:23:51 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.252 2005/09/14 03:46:50 dgp Exp $
*/
#ifndef _TCLINT
@@ -2001,7 +2001,10 @@ MODULE_SCOPE void TclFinalizePreserve(void);
MODULE_SCOPE void TclFinalizeSynchronization(void);
MODULE_SCOPE void TclFinalizeThreadData(void);
MODULE_SCOPE void TclFormatNaN(double value, char* buffer);
-MODULE_SCOPE int TclFormatObj(Tcl_Interp *arg1, ...);
+MODULE_SCOPE int TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ CONST char *format, ...);
+MODULE_SCOPE int TclFormatToErrorInfo(Tcl_Interp *interp,
+ CONST char *format, ...);
MODULE_SCOPE int TclFSFileAttrIndex(Tcl_Obj *pathPtr,
CONST char *attributeName, int *indexPtr);
MODULE_SCOPE Tcl_Obj * TclGetBgErrorHandler(Tcl_Interp *interp);
@@ -2053,7 +2056,8 @@ MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc,
MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp,
int objc, Tcl_Obj *CONST objv[],
Tcl_Namespace *nsPtr, int flags);
-MODULE_SCOPE int TclObjPrintf(Tcl_Interp *arg1, ...);
+MODULE_SCOPE int TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr,
+ CONST char *format, ...);
MODULE_SCOPE int TclParseBackslash(CONST char *src,
int numBytes, int *readPtr, char *dst);
MODULE_SCOPE int TclParseHex(CONST char *src, int numBytes,
diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c
index 0b2cdb2..802e94a 100644
--- a/generic/tclStringObj.c
+++ b/generic/tclStringObj.c
@@ -33,7 +33,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStringObj.c,v 1.44 2005/09/13 21:23:51 dgp Exp $ */
+ * RCS: @(#) $Id: tclStringObj.c,v 1.45 2005/09/14 03:46:50 dgp Exp $ */
#include "tclInt.h"
@@ -53,8 +53,10 @@ static void AppendUtfToUtfRep _ANSI_ARGS_((Tcl_Obj *objPtr,
CONST char *bytes, int numBytes));
static void FillUnicodeRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static int FormatObjVA _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, CONST char *format,
va_list argList));
static int ObjPrintfVA _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr, CONST char *format,
va_list argList));
static void FreeStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
static void DupStringInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
@@ -2214,23 +2216,13 @@ TclAppendFormattedObjs(interp, baseObj, format, objc, objv)
*/
static int
-FormatObjVA(interp, argList)
- Tcl_Interp *interp;
- va_list argList;
+FormatObjVA(Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ CONST char *format,
+ va_list argList)
{
int code, objc;
Tcl_Obj **objv, *element, *list = Tcl_NewObj();
- CONST char *format;
- Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *);
-
- if (objPtr == NULL) {
- Tcl_Panic("TclFormatObj: no Tcl_Obj to append to");
- }
-
- format = va_arg(argList, CONST char *);
- if (format == NULL) {
- Tcl_Panic("TclFormatObj: no format string argument");
- }
Tcl_IncrRefCount(list);
element = va_arg(argList, Tcl_Obj *);
@@ -2259,13 +2251,13 @@ FormatObjVA(interp, argList)
*/
int
-TclFormatObj(Tcl_Interp *interp, ...)
+TclFormatObj(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
{
va_list argList;
int result;
- va_start(argList, interp);
- result = FormatObjVA(interp, argList);
+ va_start(argList, format);
+ result = FormatObjVA(interp, objPtr, format, argList);
va_end(argList);
return result;
}
@@ -2283,24 +2275,17 @@ TclFormatObj(Tcl_Interp *interp, ...)
*/
static int
-ObjPrintfVA(interp, argList)
- Tcl_Interp *interp;
- va_list argList;
+ObjPrintfVA(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ CONST char *format,
+ va_list argList)
{
int code, objc;
Tcl_Obj **objv, *list = Tcl_NewObj();
- CONST char *format, *p;
- Tcl_Obj *objPtr = va_arg(argList, Tcl_Obj *);
-
- if (objPtr == NULL) {
- Tcl_Panic("TclObjPrintf: no Tcl_Obj to append to");
- }
-
- p = format = va_arg(argList, CONST char *);
- if (format == NULL) {
- Tcl_Panic("TclObjPrintf: no format string argument");
- }
+ CONST char *p;
+ p = format;
Tcl_IncrRefCount(list);
while (*p != '\0') {
int size = 0;
@@ -2384,18 +2369,48 @@ ObjPrintfVA(interp, argList)
*/
int
-TclObjPrintf(Tcl_Interp *interp, ...)
+TclObjPrintf(Tcl_Interp *interp, Tcl_Obj *objPtr, CONST char *format, ...)
{
va_list argList;
int result;
- va_start(argList, interp);
- result = ObjPrintfVA(interp, argList);
+ va_start(argList, format);
+ result = ObjPrintfVA(interp, objPtr, format, argList);
va_end(argList);
return result;
}
/*
+ *----------------------------------------------------------------------
+ *
+ * TclFormatToErrorInfo --
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclFormatToErrorInfo(Tcl_Interp *interp, CONST char *format, ...)
+{
+ int code;
+ va_list argList;
+ Tcl_Obj *objPtr = Tcl_NewObj();
+
+ va_start(argList, format);
+ code = ObjPrintfVA(interp, objPtr, format, argList);
+ va_end(argList);
+ if (code != TCL_OK) {
+ return code;
+ }
+ TclAppendObjToErrorInfo(interp, objPtr);
+ Tcl_DecrRefCount(objPtr);
+ return TCL_OK;
+}
+
+/*
*---------------------------------------------------------------------------
*
* FillUnicodeRep --