From d6a5a988b1a1360a77a043ec10d175c8a6c0fd36 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 14 Sep 2005 03:46:50 +0000 Subject: * 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(). --- ChangeLog | 6 ++++ generic/tclBasic.c | 21 +++---------- generic/tclInt.h | 10 ++++-- generic/tclStringObj.c | 85 +++++++++++++++++++++++++++++--------------------- 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 + * 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 -- -- cgit v0.12