diff options
author | stanton <stanton> | 1999-03-08 20:14:02 (GMT) |
---|---|---|
committer | stanton <stanton> | 1999-03-08 20:14:02 (GMT) |
commit | b825d52a6a6fc13fa86d2dd2b066dbc24ae954be (patch) | |
tree | 7ff9d7f16861bf93b582fd332bd79ffe4a8280a8 /generic/tclResult.c | |
parent | 2efea334f7d59bc5e801dd8d131acd64c4ae7874 (diff) | |
download | tcl-b825d52a6a6fc13fa86d2dd2b066dbc24ae954be.zip tcl-b825d52a6a6fc13fa86d2dd2b066dbc24ae954be.tar.gz tcl-b825d52a6a6fc13fa86d2dd2b066dbc24ae954be.tar.bz2 |
First pass at integrating stubs mechanism from 8.0.
Diffstat (limited to 'generic/tclResult.c')
-rw-r--r-- | generic/tclResult.c | 106 |
1 files changed, 88 insertions, 18 deletions
diff --git a/generic/tclResult.c b/generic/tclResult.c index 3f09149..c48fb96 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.1.2.3 1999/02/10 23:31:19 stanton Exp $ + * RCS: @(#) $Id: tclResult.c,v 1.1.2.3.2.1 1999/03/08 20:14:11 stanton Exp $ */ #include "tclInt.h" @@ -430,7 +430,7 @@ Tcl_GetObjResult(interp) /* *---------------------------------------------------------------------- * - * Tcl_AppendResult -- + * Tcl_AppendResultVA -- * * Append a variable number of strings onto the interpreter's string * result. @@ -440,8 +440,8 @@ Tcl_GetObjResult(interp) * * Side effects: * The result of the interpreter given by the first argument is - * extended by the strings given by the second and following arguments - * (up to a terminating NULL argument). + * extended by the strings in the va_list (up to a terminating NULL + * argument). * * If the string result is empty, the object result is moved to the * string result, then the object result is reset. @@ -450,10 +450,13 @@ Tcl_GetObjResult(interp) */ void -Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) +Tcl_AppendResultVA (interp, argList) + Tcl_Interp *interp; /* Interpreter with which to associate the + * return value. */ + va_list argList; /* Variable argument list. */ { - va_list argList; - Interp *iPtr; + Interp *iPtr = (Interp *) interp; + va_list tmpArgList; char *string; int newSpace; @@ -462,7 +465,6 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) * string result, then reset the object result. */ - iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList); if (*(iPtr->result) == 0) { Tcl_SetResult((Tcl_Interp *) iPtr, TclGetString(Tcl_GetObjResult((Tcl_Interp *) iPtr)), @@ -473,15 +475,15 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) * Scan through all the arguments to see how much space is needed. */ + tmpArgList = argList; newSpace = 0; while (1) { - string = va_arg(argList, char *); + string = va_arg(tmpArgList, char *); if (string == NULL) { break; } newSpace += strlen(string); } - va_end(argList); /* * If the append buffer isn't already setup and large enough to hold @@ -499,7 +501,6 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) * buffer. */ - TCL_VARARGS_START(Tcl_Interp *,arg1,argList); while (1) { string = va_arg(argList, char *); if (string == NULL) { @@ -508,6 +509,38 @@ Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) strcpy(iPtr->appendResult + iPtr->appendUsed, string); iPtr->appendUsed += strlen(string); } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_AppendResult -- + * + * Append a variable number of strings onto the interpreter's string + * result. + * + * Results: + * None. + * + * Side effects: + * The result of the interpreter given by the first argument is + * extended by the strings given by the second and following arguments + * (up to a terminating NULL argument). + * + * If the string result is empty, the object result is moved to the + * string result, then the object result is reset. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_AppendResult TCL_VARARGS_DEF(Tcl_Interp *,arg1) +{ + Tcl_Interp *interp; + va_list argList; + + interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList); + Tcl_AppendResultVA(interp, argList); va_end(argList); } @@ -792,7 +825,7 @@ ResetObjResult(iPtr) /* *---------------------------------------------------------------------- * - * Tcl_SetErrorCode -- + * Tcl_SetErrorCodeVA -- * * This procedure is called to record machine-readable information * about an error that is about to be returned. @@ -809,21 +842,22 @@ ResetObjResult(iPtr) * *---------------------------------------------------------------------- */ - /* VARARGS2 */ + void -Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1) +Tcl_SetErrorCodeVA (interp, argList) + Tcl_Interp *interp; /* Interpreter in which to access the errorCode + * variable. */ + va_list argList; /* Variable argument list. */ { - va_list argList; char *string; int flags; - Interp *iPtr; + Interp *iPtr = (Interp *) interp; /* * Scan through the arguments one at a time, appending them to * $errorCode as list elements. */ - iPtr = (Interp *) TCL_VARARGS_START(Tcl_Interp *,arg1,argList); flags = TCL_GLOBAL_ONLY | TCL_LIST_ELEMENT; while (1) { string = va_arg(argList, char *); @@ -834,13 +868,49 @@ Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1) (char *) NULL, string, flags); flags |= TCL_APPEND_VALUE; } - va_end(argList); iPtr->flags |= ERROR_CODE_SET; } /* *---------------------------------------------------------------------- * + * Tcl_SetErrorCode -- + * + * This procedure is called to record machine-readable information + * about an error that is about to be returned. + * + * Results: + * None. + * + * Side effects: + * The errorCode global variable is modified to hold all of the + * arguments to this procedure, in a list form with each argument + * becoming one element of the list. A flag is set internally + * to remember that errorCode has been set, so the variable doesn't + * get set automatically when the error is returned. + * + *---------------------------------------------------------------------- + */ + /* VARARGS2 */ +void +Tcl_SetErrorCode TCL_VARARGS_DEF(Tcl_Interp *,arg1) +{ + Tcl_Interp *interp; + va_list argList; + + /* + * Scan through the arguments one at a time, appending them to + * $errorCode as list elements. + */ + + interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList); + Tcl_SetErrorCodeVA(interp, argList); + va_end(argList); +} + +/* + *---------------------------------------------------------------------- + * * Tcl_SetObjErrorCode -- * * This procedure is called to record machine-readable information |