diff options
| author | dgp <dgp@noemail.net> | 2002-08-05 03:24:38 (GMT) |
|---|---|---|
| committer | dgp <dgp@noemail.net> | 2002-08-05 03:24:38 (GMT) |
| commit | 892965716ced280aa97146b1fac12c129de65db1 (patch) | |
| tree | 55bc26f8f6a88258d08fd90ff9a8943937349574 | |
| parent | edf2c0e3f562577e072bbc9607a573a51d2c09fb (diff) | |
| download | tcl-892965716ced280aa97146b1fac12c129de65db1.zip tcl-892965716ced280aa97146b1fac12c129de65db1.tar.gz tcl-892965716ced280aa97146b1fac12c129de65db1.tar.bz2 | |
* doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify
* doc/Concat.3: all remaining public interfaces of Tcl.
* doc/CrtCommand.3: Notably, the parser no longer writes on
* doc/CrtSlave.3: the string it is parsing, so it is no
* doc/CrtTrace.3: longer necessary for Tcl_Eval() to be
* doc/Eval.3: given a writable string. Also, the
* doc/ExprLong.3: refactoring of the Tcl_*Var* routines
* doc/LinkVar.3: by Miguel Sofer is included, so that the
* doc/ParseCmd.3: "part1" argument for them no longer needs
* doc/SetVar.3: to be writable either.
* doc/TraceVar.3:
* doc/UpVar.3: Compatibility support has been enhanced so
* generic/tcl.decls that a #define of USE_NON_CONST will remove
* generic/tcl.h all possible source incompatibilities with
* generic/tclBasic.c the 8.3 version of the header file(s).
* generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does
* generic/tclCompCmds.c what USE_NON_CONST used to do -- disable
* generic/tclCompExpr.c only those new CONST's that introduce
* generic/tclCompile.c irreconcilable incompatibilities.
* generic/tclCompile.h
* generic/tclDecls.h Several bugs are also fixed by this patch.
* generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429]
* generic/tclEvent.c
* generic/tclInt.decls
* generic/tclInt.h
* generic/tclIntDecls.h
* generic/tclInterp.c
* generic/tclLink.c
* generic/tclObj.c
* generic/tclParse.c
* generic/tclParseExpr.c
* generic/tclProc.c
* generic/tclTest.c
* generic/tclUtf.c
* generic/tclUtil.c
* generic/tclVar.c
* mac/tclMacTest.c
* tests/expr-old.test
* tests/parseExpr.test
* unix/tclUnixTest.c
* unix/tclXtTest.c
* win/tclWinTest.c
FossilOrigin-Name: e476c22fecaa0dd7fea635d29d8ea1d5579365a1
43 files changed, 1680 insertions, 1395 deletions
@@ -1,3 +1,48 @@ +2002-08-04 Don Porter <dgp@users.sourceforge.net> + + * doc/CmdCmplt.3: Applied Patch 585105 to fully CONST-ify + * doc/Concat.3: all remaining public interfaces of Tcl. + * doc/CrtCommand.3: Notably, the parser no longer writes on + * doc/CrtSlave.3: the string it is parsing, so it is no + * doc/CrtTrace.3: longer necessary for Tcl_Eval() to be + * doc/Eval.3: given a writable string. Also, the + * doc/ExprLong.3: refactoring of the Tcl_*Var* routines + * doc/LinkVar.3: by Miguel Sofer is included, so that the + * doc/ParseCmd.3: "part1" argument for them no longer needs + * doc/SetVar.3: to be writable either. + * doc/TraceVar.3: + * doc/UpVar.3: Compatibility support has been enhanced so + * generic/tcl.decls that a #define of USE_NON_CONST will remove + * generic/tcl.h all possible source incompatibilities with + * generic/tclBasic.c the 8.3 version of the header file(s). + * generic/tclCmdMZ.c The new #define of USE_COMPAT_CONST now does + * generic/tclCompCmds.c what USE_NON_CONST used to do -- disable + * generic/tclCompExpr.c only those new CONST's that introduce + * generic/tclCompile.c irreconcilable incompatibilities. + * generic/tclCompile.h + * generic/tclDecls.h Several bugs are also fixed by this patch. + * generic/tclEnv.c [Bugs 584051,580433] [Patches 585105,582429] + * generic/tclEvent.c + * generic/tclInt.decls + * generic/tclInt.h + * generic/tclIntDecls.h + * generic/tclInterp.c + * generic/tclLink.c + * generic/tclObj.c + * generic/tclParse.c + * generic/tclParseExpr.c + * generic/tclProc.c + * generic/tclTest.c + * generic/tclUtf.c + * generic/tclUtil.c + * generic/tclVar.c + * mac/tclMacTest.c + * tests/expr-old.test + * tests/parseExpr.test + * unix/tclUnixTest.c + * unix/tclXtTest.c + * win/tclWinTest.c + 2002-08-01 Miguel Sofer <msofer@users.sourceforge.net> * generic/tclExecute.c: bugfix (reading freed memory). Testsuite diff --git a/doc/CmdCmplt.3 b/doc/CmdCmplt.3 index b7effed..718bdf0 100644 --- a/doc/CmdCmplt.3 +++ b/doc/CmdCmplt.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: CmdCmplt.3,v 1.2 1998/09/14 18:39:46 stanton Exp $ +'\" RCS: @(#) $Id: CmdCmplt.3,v 1.3 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_CommandComplete 3 "" Tcl "Tcl Library Procedures" @@ -19,8 +19,8 @@ Tcl_CommandComplete \- Check for unmatched braces in a Tcl command int \fBTcl_CommandComplete\fR(\fIcmd\fR) .SH ARGUMENTS -.AS char *cmd -.AP char *cmd in +.AS "CONST char" *cmd +.AP "CONST char" *cmd in Command string to test for completeness. .BE diff --git a/doc/Concat.3 b/doc/Concat.3 index d67eca3..7c6df03 100644 --- a/doc/Concat.3 +++ b/doc/Concat.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Concat.3,v 1.4 2002/01/25 20:40:55 dgp Exp $ +'\" RCS: @(#) $Id: Concat.3,v 1.5 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_Concat 3 7.5 Tcl "Tcl Library Procedures" @@ -16,7 +16,7 @@ Tcl_Concat \- concatenate a collection of strings .nf \fB#include <tcl.h>\fR .sp -char * +CONST char * \fBTcl_Concat\fR(\fIargc, argv\fR) .SH ARGUMENTS .AP int argc in diff --git a/doc/CrtCommand.3 b/doc/CrtCommand.3 index 4b18a85..f766361 100644 --- a/doc/CrtCommand.3 +++ b/doc/CrtCommand.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: CrtCommand.3,v 1.4 2001/04/24 20:59:17 kennykb Exp $ +'\" RCS: @(#) $Id: CrtCommand.3,v 1.5 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_CreateCommand 3 "" Tcl "Tcl Library Procedures" @@ -84,7 +84,7 @@ typedef int Tcl_CmdProc( ClientData \fIclientData\fR, Tcl_Interp *\fIinterp\fR, int \fIargc\fR, - char *\fIargv\fR[]); + CONST char *\fIargv\fR[]); .CE When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR parameters will be copies of the \fIclientData\fR and \fIinterp\fR diff --git a/doc/CrtSlave.3 b/doc/CrtSlave.3 index 4966fc0..96765fd 100644 --- a/doc/CrtSlave.3 +++ b/doc/CrtSlave.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: CrtSlave.3,v 1.7 2002/07/01 18:24:39 jenglish Exp $ +'\" RCS: @(#) $Id: CrtSlave.3,v 1.8 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_CreateSlave 3 7.6 Tcl "Tcl Library Procedures" @@ -73,7 +73,7 @@ Interpreter that contains the target command for an alias. Name of target command for alias in \fItargetInterp\fR. .AP int argc in Count of additional arguments to pass to the alias command. -.AP "char * CONST" *argv in +.AP "CONST char * CONST" *argv in Vector of strings, the additional arguments to pass to the alias command. This storage is owned by the caller. .AP int objc in @@ -91,7 +91,7 @@ for an alias. .AP int *argcPtr out Pointer to location to store count of additional arguments to be passed to the alias. The location is in storage owned by the caller. -.AP char ***argvPtr out +.AP "CONST char" ***argvPtr out Pointer to location to store a vector of strings, the additional arguments to pass to an alias. The location is in storage owned by the caller, the vector of strings is owned by the called function. diff --git a/doc/CrtTrace.3 b/doc/CrtTrace.3 index a1c80e3..17a688d 100644 --- a/doc/CrtTrace.3 +++ b/doc/CrtTrace.3 @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: CrtTrace.3,v 1.5 2002/06/17 22:52:50 hobbs Exp $ +'\" RCS: @(#) $Id: CrtTrace.3,v 1.6 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_CreateTrace 3 "" Tcl "Tcl Library Procedures" @@ -165,7 +165,7 @@ typedef void Tcl_CmdTraceProc( Tcl_CmdProc *\fIcmdProc\fR, ClientData \fIcmdClientData\fR, int \fIargc\fR, - char *\fIargv\fR[]); + CONST char *\fIargv\fR[]); .CE The parameters to the \fIproc\fR callback are similar to those of the \fIobjProc\fR callback above. The \fIcommandToken\fR is @@ -6,7 +6,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: Eval.3,v 1.11 2002/07/01 18:24:39 jenglish Exp $ +'\" RCS: @(#) $Id: Eval.3,v 1.12 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_Eval 3 8.1 Tcl "Tcl Library Procedures" @@ -66,10 +66,8 @@ value of a single word in the command to execute. The number of bytes in \fIscript\fR, not including any null terminating character. If \-1, then all characters up to the first null byte are used. -.AP char *script in +.AP "CONST char" *script in Points to first byte of script to execute (NULL terminated and UTF-8). -This script must be in writable memory: temporary modifications are made -to it during parsing. .AP char *string in String forming part of a Tcl script. .AP va_list argList in diff --git a/doc/ExprLong.3 b/doc/ExprLong.3 index 9cc3900..23f3a67 100644 --- a/doc/ExprLong.3 +++ b/doc/ExprLong.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ExprLong.3,v 1.5 2001/12/10 15:50:46 dgp Exp $ +'\" RCS: @(#) $Id: ExprLong.3,v 1.6 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_ExprLong 3 7.0 Tcl "Tcl Library Procedures" @@ -34,9 +34,7 @@ Interpreter in whose context to evaluate \fIstring\fR or \fIobjPtr\fR. .VS 8.4 .AP "CONST char" *string in .VE -Expression to be evaluated. Must be in writable memory (the expression -parser makes temporary modifications to the string during parsing, which -it undoes before returning). +Expression to be evaluated. .AP long *longPtr out Pointer to location in which to store the integer value of the expression. diff --git a/doc/LinkVar.3 b/doc/LinkVar.3 index 7d07d01..c344b5e 100644 --- a/doc/LinkVar.3 +++ b/doc/LinkVar.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: LinkVar.3,v 1.5 2002/02/26 02:22:20 hobbs Exp $ +'\" RCS: @(#) $Id: LinkVar.3,v 1.6 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_LinkVar 3 7.5 Tcl "Tcl Library Procedures" @@ -27,9 +27,8 @@ int .AP Tcl_Interp *interp in Interpreter that contains \fIvarName\fR. Also used by \fBTcl_LinkVar\fR to return error messages. -.AP char *varName in -Name of global variable. Must be in writable memory: Tcl may make -temporary modifications to it while parsing the variable name. +.AP "CONST char" *varName in +Name of global variable. .AP char *addr in Address of C variable that is to be linked to \fIvarName\fR. .AP int type in diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 42f1ba3..0986d8e 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -4,7 +4,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: ParseCmd.3,v 1.9 2002/07/01 18:24:39 jenglish Exp $ +'\" RCS: @(#) $Id: ParseCmd.3,v 1.10 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_ParseCommand 3 8.3 Tcl "Tcl Library Procedures" @@ -49,7 +49,7 @@ if NULL, then no error messages are left after errors. For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, determines the context for evaluating the script and also is used for error reporting; must not be NULL. -.AP char *string in +.AP "CONST char" *string in Pointer to first character in string to parse. .AP int numBytes in Number of bytes in \fIstring\fR, not including any terminating null @@ -71,7 +71,7 @@ Any previous information in this structure is ignored, unless \fIappend\fR is non-zero in a call to \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, or \fBTcl_ParseVarName\fR. -.AP char **termPtr out +.AP "CONST char" **termPtr out If not NULL, points to a location where \fBTcl_ParseBraces\fR, \fBTcl_ParseQuotedString\fR, and \fBTcl_ParseVar\fR will store a pointer to the character diff --git a/doc/SetVar.3 b/doc/SetVar.3 index d40f1dd..f39725e 100644 --- a/doc/SetVar.3 +++ b/doc/SetVar.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: SetVar.3,v 1.6 2002/03/29 02:39:27 davygrvy Exp $ +'\" RCS: @(#) $Id: SetVar.3,v 1.7 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_SetVar 3 8.1 Tcl "Tcl Library Procedures" @@ -53,7 +53,7 @@ int .AS Tcl_Interp *newValuePtr .AP Tcl_Interp *interp in Interpreter containing variable. -.AP char *name1 in +.AP "CONST char" *name1 in Contains the name of an array variable (if \fIname2\fR is non-NULL) or (if \fIname2\fR is NULL) either the name of a scalar variable or a complete name including both variable name and index. @@ -69,15 +69,12 @@ Points to a Tcl object containing the new value for the variable. .AP int flags in OR-ed combination of bits providing additional information. See below for valid values. -.AP char *varName in +.AP "CONST char" *varName in Name of variable. May include \fB::\fR namespace qualifiers to specify a variable in a particular namespace. May refer to a scalar variable or an element of an array. -If the name references an element of an array, then the name -must be in writable memory: Tcl will make temporary modifications -to it while looking up the name. .AP "CONST char" *newValue in New value for variable, specified as a NULL-terminated string. A copy of this value is stored in the variable. diff --git a/doc/TraceVar.3 b/doc/TraceVar.3 index 4f9d9a6..0807a7e 100644 --- a/doc/TraceVar.3 +++ b/doc/TraceVar.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: TraceVar.3,v 1.7 2002/03/29 02:39:27 davygrvy Exp $ +'\" RCS: @(#) $Id: TraceVar.3,v 1.8 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_TraceVar 3 7.4 Tcl "Tcl Library Procedures" @@ -35,13 +35,10 @@ ClientData .AS Tcl_VarTraceProc prevClientData .AP Tcl_Interp *interp in Interpreter containing variable. -.AP char *varName in +.AP "CONST char" *varName in Name of variable. May refer to a scalar variable, to an array variable with no index, or to an array variable with a parenthesized index. -If the name references an element of an array, then it -must be in writable memory: Tcl will make temporary modifications -to it while looking up the name. .AP int flags in OR-ed combination of the values TCL_TRACE_READS, TCL_TRACE_WRITES, TCL_TRACE_UNSETS, TCL_TRACE_ARRAY, TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, @@ -52,7 +49,7 @@ procedures. See below for more information. Procedure to invoke whenever one of the traced operations occurs. .AP ClientData clientData in Arbitrary one-word value to pass to \fIproc\fR. -.AP char *name1 in +.AP "CONST char" *name1 in Name of scalar or array variable (without array index). .AP "CONST char" *name2 in For a trace on an element of an array, gives the index of the diff --git a/doc/UpVar.3 b/doc/UpVar.3 index 2e4e6ee..fd65cd3 100644 --- a/doc/UpVar.3 +++ b/doc/UpVar.3 @@ -5,7 +5,7 @@ '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. '\" -'\" RCS: @(#) $Id: UpVar.3,v 1.6 2002/03/29 02:39:27 davygrvy Exp $ +'\" RCS: @(#) $Id: UpVar.3,v 1.7 2002/08/05 03:24:39 dgp Exp $ '\" .so man.macros .TH Tcl_UpVar 3 7.4 Tcl "Tcl Library Procedures" @@ -29,7 +29,7 @@ Interpreter containing variables; also used for error reporting. Identifies the stack frame containing source variable. May have any of the forms accepted by the \fBupvar\fR command, such as \fB#0\fR or \fB1\fR. -.AP char *sourceName in +.AP "CONST char" *sourceName in Name of source variable, in the frame given by \fIframeName\fR. May refer to a scalar variable or to an array variable with a parenthesized index. @@ -42,7 +42,7 @@ an upvar-ed variable. Either TCL_GLOBAL_ONLY or 0; if non-zero, then \fIdestName\fR is a global variable; otherwise it is a local to the current procedure (or global if no procedure is active). -.AP char *name1 in +.AP "CONST char" *name1 in First part of source variable's name (scalar name, or name of array without array index). .AP "CONST char" *name2 in diff --git a/generic/tcl.decls b/generic/tcl.decls index 6e0f5f5..faf06bd 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -11,7 +11,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.91 2002/07/22 16:51:47 vincentdarley Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.92 2002/08/05 03:24:39 dgp Exp $ library tcl @@ -32,7 +32,7 @@ declare 0 generic { CONST char* version, ClientData clientData) } declare 1 generic { - CONST char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name, + CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr) } declare 2 generic { @@ -303,10 +303,10 @@ declare 81 generic { int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan) } declare 82 generic { - int Tcl_CommandComplete(char *cmd) + int Tcl_CommandComplete(CONST char *cmd) } declare 83 generic { - char * Tcl_Concat(int argc, CONST84 char * CONST *argv) + CONST84_RETURN char * Tcl_Concat(int argc, CONST84 char * CONST *argv) } declare 84 generic { int Tcl_ConvertElement(CONST char *src, char *dst, int flags) @@ -318,7 +318,7 @@ declare 85 generic { declare 86 generic { int Tcl_CreateAlias(Tcl_Interp *slave, CONST char *slaveCmd, Tcl_Interp *target, CONST char *targetCmd, int argc, - char * CONST *argv) + CONST84 char * CONST *argv) } declare 87 generic { int Tcl_CreateAliasObj(Tcl_Interp *slave, CONST char *slaveCmd, @@ -461,13 +461,13 @@ declare 126 generic { int Tcl_Eof(Tcl_Channel chan) } declare 127 generic { - CONST char * Tcl_ErrnoId(void) + CONST84_RETURN char * Tcl_ErrnoId(void) } declare 128 generic { - CONST char * Tcl_ErrnoMsg(int err) + CONST84_RETURN char * Tcl_ErrnoMsg(int err) } declare 129 generic { - int Tcl_Eval(Tcl_Interp *interp, char *string) + int Tcl_Eval(Tcl_Interp *interp, CONST char *string) } # This is obsolete, use Tcl_FSEvalFile declare 130 generic { @@ -530,7 +530,7 @@ declare 147 generic { declare 148 generic { int Tcl_GetAlias(Tcl_Interp *interp, CONST char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, - int *argcPtr, char ***argvPtr) + int *argcPtr, CONST84 char ***argvPtr) } declare 149 generic { int Tcl_GetAliasObj(Tcl_Interp *interp, CONST char *slaveCmd, @@ -559,7 +559,7 @@ declare 155 generic { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 generic { - CONST char * Tcl_GetChannelName(Tcl_Channel chan) + CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan) } declare 157 generic { int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, @@ -573,13 +573,14 @@ declare 159 generic { Tcl_CmdInfo *infoPtr) } declare 160 generic { - CONST char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command) + CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp, + Tcl_Command command) } declare 161 generic { int Tcl_GetErrno(void) } declare 162 generic { - CONST char * Tcl_GetHostName(void) + CONST84_RETURN char * Tcl_GetHostName(void) } declare 163 generic { int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp) @@ -622,17 +623,18 @@ declare 173 generic { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 generic { - CONST char * Tcl_GetStringResult(Tcl_Interp *interp) + CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp) } declare 175 generic { - CONST char * Tcl_GetVar(Tcl_Interp *interp, char *varName, int flags) + CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, CONST char *varName, + int flags) } declare 176 generic { - CONST char * Tcl_GetVar2(Tcl_Interp *interp, char *part1, CONST char *part2, - int flags) + CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, CONST char *part1, + CONST char *part2, int flags) } declare 177 generic { - int Tcl_GlobalEval(Tcl_Interp *interp, char *command) + int Tcl_GlobalEval(Tcl_Interp *interp, CONST char *command) } declare 178 generic { int Tcl_GlobalEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr) @@ -665,7 +667,8 @@ declare 186 generic { Tcl_DString *resultPtr) } declare 187 generic { - int Tcl_LinkVar(Tcl_Interp *interp, char *varName, char *addr, int type) + int Tcl_LinkVar(Tcl_Interp *interp, CONST char *varName, char *addr, + int type) } # This slot is reserved for use by the plus patch: @@ -727,7 +730,7 @@ declare 203 generic { int Tcl_PutEnv(CONST char *string) } declare 204 generic { - CONST char * Tcl_PosixError(Tcl_Interp *interp) + CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp) } declare 205 generic { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) @@ -834,18 +837,18 @@ declare 236 generic { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 generic { - CONST char * Tcl_SetVar(Tcl_Interp *interp, char *varName, + CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, CONST char *varName, CONST char *newValue, int flags) } declare 238 generic { - CONST char * Tcl_SetVar2(Tcl_Interp *interp, char *part1, CONST char *part2, - CONST char *newValue, int flags) + CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, CONST char *part1, + CONST char *part2, CONST char *newValue, int flags) } declare 239 generic { - CONST char * Tcl_SignalId(int sig) + CONST84_RETURN char * Tcl_SignalId(int sig) } declare 240 generic { - CONST char * Tcl_SignalMsg(int sig) + CONST84_RETURN char * Tcl_SignalMsg(int sig) } declare 241 generic { void Tcl_SourceRCFile(Tcl_Interp *interp) @@ -870,11 +873,11 @@ declare 246 generic { int Tcl_TellOld(Tcl_Channel chan) } declare 247 generic { - int Tcl_TraceVar(Tcl_Interp *interp, char *varName, int flags, + int Tcl_TraceVar(Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 248 generic { - int Tcl_TraceVar2(Tcl_Interp *interp, char *part1, CONST char *part2, + int Tcl_TraceVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 249 generic { @@ -885,46 +888,47 @@ declare 250 generic { int Tcl_Ungets(Tcl_Channel chan, CONST char *str, int len, int atHead) } declare 251 generic { - void Tcl_UnlinkVar(Tcl_Interp *interp, char *varName) + void Tcl_UnlinkVar(Tcl_Interp *interp, CONST char *varName) } declare 252 generic { int Tcl_UnregisterChannel(Tcl_Interp *interp, Tcl_Channel chan) } declare 253 generic { - int Tcl_UnsetVar(Tcl_Interp *interp, char *varName, int flags) + int Tcl_UnsetVar(Tcl_Interp *interp, CONST char *varName, int flags) } declare 254 generic { - int Tcl_UnsetVar2(Tcl_Interp *interp, char *part1, CONST char *part2, + int Tcl_UnsetVar2(Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags) } declare 255 generic { - void Tcl_UntraceVar(Tcl_Interp *interp, char *varName, int flags, + void Tcl_UntraceVar(Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *proc, ClientData clientData) } declare 256 generic { - void Tcl_UntraceVar2(Tcl_Interp *interp, char *part1, CONST char *part2, - int flags, Tcl_VarTraceProc *proc, ClientData clientData) + void Tcl_UntraceVar2(Tcl_Interp *interp, CONST char *part1, + CONST char *part2, int flags, Tcl_VarTraceProc *proc, + ClientData clientData) } declare 257 generic { - void Tcl_UpdateLinkedVar(Tcl_Interp *interp, char *varName) + void Tcl_UpdateLinkedVar(Tcl_Interp *interp, CONST char *varName) } declare 258 generic { - int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName, char *varName, - CONST char *localName, int flags) + int Tcl_UpVar(Tcl_Interp *interp, CONST char *frameName, + CONST char *varName, CONST char *localName, int flags) } declare 259 generic { - int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, char *part1, + int Tcl_UpVar2(Tcl_Interp *interp, CONST char *frameName, CONST char *part1, CONST char *part2, CONST char *localName, int flags) } declare 260 generic { int Tcl_VarEval(Tcl_Interp *interp, ...) } declare 261 generic { - ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, char *varName, + ClientData Tcl_VarTraceInfo(Tcl_Interp *interp, CONST char *varName, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) } declare 262 generic { - ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, char *part1, + ClientData Tcl_VarTraceInfo2(Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, Tcl_VarTraceProc *procPtr, ClientData prevClientData) } @@ -949,17 +953,18 @@ declare 268 generic { void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, va_list argList) } declare 269 generic { - CONST char * Tcl_HashStats(Tcl_HashTable *tablePtr) + CONST84_RETURN char * Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 generic { - CONST char * Tcl_ParseVar(Tcl_Interp *interp, char *str, char **termPtr) + CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, CONST char *str, + CONST84 char **termPtr) } declare 271 generic { - CONST char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name, + CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, CONST char *name, CONST char *version, int exact) } declare 272 generic { - CONST char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name, + CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, CONST char *name, CONST char *version, int exact, ClientData *clientDataPtr) } declare 273 generic { @@ -967,7 +972,7 @@ declare 273 generic { CONST char *version) } declare 274 generic { - CONST char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name, + CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, CONST char *name, CONST char *version, int exact) } declare 275 generic { @@ -1042,7 +1047,8 @@ declare 290 generic { void Tcl_DiscardResult(Tcl_SavedResult *statePtr) } declare 291 generic { - int Tcl_EvalEx(Tcl_Interp *interp, char *script, int numBytes, int flags) + int Tcl_EvalEx(Tcl_Interp *interp, CONST char *script, int numBytes, + int flags) } declare 292 generic { int Tcl_EvalObjv(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], @@ -1080,7 +1086,7 @@ declare 301 generic { Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, CONST char *name) } declare 302 generic { - CONST char * Tcl_GetEncodingName(Tcl_Encoding encoding) + CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding) } declare 303 generic { void Tcl_GetEncodingNames(Tcl_Interp *interp) @@ -1094,8 +1100,8 @@ declare 305 generic { VOID * Tcl_GetThreadData(Tcl_ThreadDataKey *keyPtr, int size) } declare 306 generic { - Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, char *part1, CONST char *part2, - int flags) + Tcl_Obj * Tcl_GetVar2Ex(Tcl_Interp *interp, CONST char *part1, + CONST char *part2, int flags) } declare 307 generic { ClientData Tcl_InitNotifier(void) @@ -1130,8 +1136,8 @@ declare 316 generic { int Tcl_SetSystemEncoding(Tcl_Interp *interp, CONST char *name) } declare 317 generic { - Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, char *part1, CONST char *part2, - Tcl_Obj *newValuePtr, int flags) + Tcl_Obj * Tcl_SetVar2Ex(Tcl_Interp *interp, CONST char *part1, + CONST char *part2, Tcl_Obj *newValuePtr, int flags) } declare 318 generic { void Tcl_ThreadAlert(Tcl_ThreadId threadId) @@ -1156,7 +1162,7 @@ declare 324 generic { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 generic { - CONST char * Tcl_UtfAtIndex(CONST char *src, int index) + CONST84_RETURN char * Tcl_UtfAtIndex(CONST char *src, int index) } declare 326 generic { int Tcl_UtfCharComplete(CONST char *src, int len) @@ -1165,16 +1171,16 @@ declare 327 generic { int Tcl_UtfBackslash(CONST char *src, int *readPtr, char *dst) } declare 328 generic { - CONST char * Tcl_UtfFindFirst(CONST char *src, int ch) + CONST84_RETURN char * Tcl_UtfFindFirst(CONST char *src, int ch) } declare 329 generic { - CONST char * Tcl_UtfFindLast(CONST char *src, int ch) + CONST84_RETURN char * Tcl_UtfFindLast(CONST char *src, int ch) } declare 330 generic { - CONST char * Tcl_UtfNext(CONST char *src) + CONST84_RETURN char * Tcl_UtfNext(CONST char *src) } declare 331 generic { - CONST char * Tcl_UtfPrev(CONST char *src, CONST char *start) + CONST84_RETURN char * Tcl_UtfPrev(CONST char *src, CONST char *start) } declare 332 generic { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, @@ -1208,7 +1214,7 @@ declare 340 generic { char * Tcl_GetString(Tcl_Obj *objPtr) } declare 341 generic { - CONST char * Tcl_GetDefaultEncodingDir(void) + CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void) } declare 342 generic { void Tcl_SetDefaultEncodingDir(CONST char *path) @@ -1272,23 +1278,24 @@ declare 359 generic { CONST char *command, int length) } declare 360 generic { - int Tcl_ParseBraces(Tcl_Interp *interp, char *string, - int numBytes, Tcl_Parse *parsePtr, int append, char **termPtr) + int Tcl_ParseBraces(Tcl_Interp *interp, CONST char *string, int numBytes, + Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) } declare 361 generic { - int Tcl_ParseCommand(Tcl_Interp *interp, char *string, int numBytes, + int Tcl_ParseCommand(Tcl_Interp *interp, CONST char *string, int numBytes, int nested, Tcl_Parse *parsePtr) } declare 362 generic { - int Tcl_ParseExpr(Tcl_Interp *interp, char *string, int numBytes, + int Tcl_ParseExpr(Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr) } declare 363 generic { - int Tcl_ParseQuotedString(Tcl_Interp *interp, char *string, int numBytes, - Tcl_Parse *parsePtr, int append, char **termPtr) + int Tcl_ParseQuotedString(Tcl_Interp *interp, CONST char *string, + int numBytes, Tcl_Parse *parsePtr, int append, + CONST84 char **termPtr) } declare 364 generic { - int Tcl_ParseVarName(Tcl_Interp *interp, char *string, int numBytes, + int Tcl_ParseVarName(Tcl_Interp *interp, CONST char *string, int numBytes, Tcl_Parse *parsePtr, int append) } # These 4 functions are obsolete, use Tcl_FSGetCwd, Tcl_FSChdir, @@ -1401,7 +1408,7 @@ declare 397 generic { int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 generic { - CONST char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr) + CONST84_RETURN char * Tcl_ChannelName(Tcl_ChannelType *chanTypePtr) } declare 399 generic { Tcl_ChannelTypeVersion Tcl_ChannelVersion(Tcl_ChannelType *chanTypePtr) diff --git a/generic/tcl.h b/generic/tcl.h index 3e6e19c..3bf2ae0 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.138 2002/07/29 15:56:53 msofer Exp $ + * RCS: @(#) $Id: tcl.h,v 1.139 2002/08/05 03:24:40 dgp Exp $ */ #ifndef _TCL @@ -249,9 +249,19 @@ extern "C" { #endif #ifdef USE_NON_CONST +# ifdef USE_COMPAT_CONST +# error define at most one of USE_NON_CONST and USE_COMPAT_CONST +# endif # define CONST84 +# define CONST84_RETURN #else -# define CONST84 CONST +# ifdef USE_COMPAT_CONST +# define CONST84 +# define CONST84_RETURN CONST +# else +# define CONST84 CONST +# define CONST84_RETURN CONST +# endif #endif @@ -636,10 +646,10 @@ typedef void (Tcl_ChannelProc) _ANSI_ARGS_((ClientData clientData, int mask)); typedef void (Tcl_CloseProc) _ANSI_ARGS_((ClientData data)); typedef void (Tcl_CmdDeleteProc) _ANSI_ARGS_((ClientData clientData)); typedef int (Tcl_CmdProc) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char *argv[])); + Tcl_Interp *interp, int argc, CONST84 char *argv[])); typedef void (Tcl_CmdTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, char *argv[])); + ClientData cmdClientData, int argc, CONST84 char *argv[])); typedef int (Tcl_CmdObjTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int level, CONST char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj * CONST * objv)); @@ -680,7 +690,7 @@ typedef int (Tcl_SetFromAnyProc) _ANSI_ARGS_((Tcl_Interp *interp, struct Tcl_Obj *objPtr)); typedef void (Tcl_UpdateStringProc) _ANSI_ARGS_((struct Tcl_Obj *objPtr)); typedef char *(Tcl_VarTraceProc) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *part1, CONST84 char *part2, int flags)); + Tcl_Interp *interp, CONST84 char *part1, CONST84 char *part2, int flags)); typedef void (Tcl_CommandTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)); @@ -1583,7 +1593,7 @@ typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions)); typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp, - Tcl_Obj *result, Tcl_Obj *pathPtr, CONST84 char *pattern, + Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern, Tcl_GlobTypeData * types)); typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp)); typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr)); @@ -1610,7 +1620,7 @@ typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp, typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef)); -typedef CONST84 char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, +typedef CONST char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef)); typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp, int index, Tcl_Obj *pathPtr, @@ -1934,7 +1944,7 @@ typedef struct Tcl_EncodingType { typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; * see below for valid types. */ - char *start; /* First character in token. */ + CONST char *start; /* First character in token. */ int size; /* Number of bytes in token. */ int numComponents; /* If this token is composed of other * tokens, this field tells how many of @@ -2048,14 +2058,14 @@ typedef struct Tcl_Token { #define NUM_STATIC_TOKENS 20 typedef struct Tcl_Parse { - char *commentStart; /* Pointer to # that begins the first of + CONST char *commentStart; /* Pointer to # that begins the first of * one or more comments preceding the * command. */ int commentSize; /* Number of bytes in comments (up through * newline character that terminates the * last comment). If there were no * comments, this field is 0. */ - char *commandStart; /* First character in first word of command. */ + CONST char *commandStart; /* First character in first word of command. */ int commandSize; /* Number of bytes in command, including * first character of first word, up * through the terminating newline, @@ -2079,13 +2089,13 @@ typedef struct Tcl_Parse { * Tcl_ParseCommand. */ - char *string; /* The original command string passed to + CONST char *string; /* The original command string passed to * Tcl_ParseCommand. */ - char *end; /* Points to the character just after the + CONST char *end; /* Points to the character just after the * last one in the command string. */ Tcl_Interp *interp; /* Interpreter to use for error reporting, * or NULL. */ - char *term; /* Points to character in string that + CONST char *term; /* Points to character in string that * terminated most recent token. Filled in * by ParseTokens. If an error occurs, * points to beginning of region where the diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e927654..b1da3ad 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.67 2002/07/29 15:56:53 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.68 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -1753,8 +1753,8 @@ TclInvokeStringCommand(clientData, interp, objc, objv) */ #define NUM_ARGS 20 - char *(argStorage[NUM_ARGS]); - char **argv = argStorage; + CONST char *(argStorage[NUM_ARGS]); + CONST char **argv = argStorage; /* * Create the string argument array "argv". Make sure argv is large @@ -1763,7 +1763,7 @@ TclInvokeStringCommand(clientData, interp, objc, objv) */ if ((objc + 1) > NUM_ARGS) { - argv = (char **) ckalloc((unsigned)(objc + 1) * sizeof(char *)); + argv = (CONST char **) ckalloc((unsigned)(objc + 1) * sizeof(char *)); } for (i = 0; i < objc; i++) { @@ -1814,7 +1814,7 @@ TclInvokeObjectCommand(clientData, interp, argc, argv) ClientData clientData; /* Points to command's Command structure. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - register char **argv; /* Argument strings. */ + register CONST char **argv; /* Argument strings. */ { Command *cmdPtr = (Command *) clientData; register Tcl_Obj *objPtr; @@ -2914,7 +2914,7 @@ TclEvalObjvInternal(interp, objc, objv, command, length, flags) int objc; /* Number of words in command. */ Tcl_Obj *CONST objv[]; /* An array of pointers to objects that are * the words that make up the command. */ - char *command; /* Points to the beginning of the string + CONST char *command; /* Points to the beginning of the string * representation of the command; this * is used for traces. If the string * representation of the command is @@ -3308,7 +3308,7 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count) #endif char nameBuffer[MAX_VAR_CHARS+1]; char *varName, *index; - char *p = NULL; /* Initialized to avoid compiler warning. */ + CONST char *p = NULL; /* Initialized to avoid compiler warning. */ int length, code; /* @@ -3516,7 +3516,7 @@ int Tcl_EvalEx(interp, script, numBytes, flags) Tcl_Interp *interp; /* Interpreter in which to evaluate the * script. Also used for error reporting. */ - char *script; /* First character of script to evaluate. */ + CONST char *script; /* First character of script to evaluate. */ int numBytes; /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ @@ -3526,7 +3526,7 @@ Tcl_EvalEx(interp, script, numBytes, flags) * supported. */ { Interp *iPtr = (Interp *) interp; - char *p, *next; + CONST char *p, *next; Tcl_Parse parse; #define NUM_STATIC_OBJS 20 Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv; @@ -3541,7 +3541,7 @@ Tcl_EvalEx(interp, script, numBytes, flags) * nothing will be read nor written there. */ - char *onePast = NULL; + CONST char *onePast = NULL; /* * The variables below keep track of how much state has been @@ -3712,7 +3712,7 @@ Tcl_EvalEx(interp, script, numBytes, flags) Tcl_FreeParse(&parse); if ((nested != 0) && (p > script)) { - char *nextCmd = NULL; /* pointer to start of next command */ + CONST char *nextCmd = NULL; /* pointer to start of next command */ /* * We get here in the special case where the TCL_BRACKET_TERM @@ -3791,11 +3791,9 @@ int Tcl_Eval(interp, string) Tcl_Interp *interp; /* Token for command interpreter (returned * by previous call to Tcl_CreateInterp). */ - char *string; /* Pointer to TCL command to execute. */ + CONST char *string; /* Pointer to TCL command to execute. */ { - int code; - - code = Tcl_EvalEx(interp, string, -1, 0); + int code = Tcl_EvalEx(interp, string, -1, 0); /* * For backwards compatibility with old C code that predates the @@ -4301,7 +4299,7 @@ int TclInvoke(interp, argc, argv, flags) Tcl_Interp *interp; /* Where to invoke the command. */ int argc; /* Count of args. */ - register char **argv; /* The arg strings; argv[0] is the name of + register CONST char **argv; /* The arg strings; argv[0] is the name of * the command to invoke. */ int flags; /* Combination of flags controlling the * call: TCL_INVOKE_HIDDEN and @@ -4398,7 +4396,7 @@ int TclGlobalInvoke(interp, argc, argv, flags) Tcl_Interp *interp; /* Where to invoke the command. */ int argc; /* Count of args. */ - register char **argv; /* The arg strings; argv[0] is the name of + register CONST char **argv; /* The arg strings; argv[0] is the name of * the command to invoke. */ int flags; /* Combination of flags controlling the * call: TCL_INVOKE_HIDDEN and @@ -4931,7 +4929,7 @@ StringTraceProc( clientData, interp, level, command, commandInfo, objc, objv ) ( data->proc )( data->clientData, interp, level, (char*) command, cmdPtr->proc, cmdPtr->clientData, - objc, (char**) argv ); + objc, argv ); ckfree( (char*) argv ); return TCL_OK; @@ -5238,7 +5236,7 @@ Tcl_VarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1) int Tcl_GlobalEval(interp, command) Tcl_Interp *interp; /* Interpreter in which to evaluate command. */ - char *command; /* Command to evaluate. */ + CONST char *command; /* Command to evaluate. */ { register Interp *iPtr = (Interp *) interp; int result; diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index ee37ff2..bc832ea 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -14,7 +14,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.73 2002/06/19 22:38:39 hobbs Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.74 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -113,11 +113,11 @@ static Tcl_TraceTypeObjCmd* traceSubCmds[] = { */ static int CallTraceProcedure _ANSI_ARGS_((Tcl_Interp *interp, Trace *tracePtr, Command *cmdPtr, - char *command, int numChars, + CONST char *command, int numChars, int objc, Tcl_Obj *CONST objv[])); static char * TraceVarProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); static void TraceCommandProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, CONST char *oldName, CONST char *newName, int flags)); @@ -4001,7 +4001,7 @@ TraceCommandProc(clientData, interp, oldName, newName, flags) int TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags, objc, objv) Tcl_Interp *interp; /* The current interpreter. */ - char *command; /* Pointer to beginning of the current + CONST char *command; /* Pointer to beginning of the current * command string. */ int numChars; /* The number of characters in 'command' * which are part of the command string. */ @@ -4081,7 +4081,7 @@ TclCheckExecutionTraces(interp, command, numChars, cmdPtr, code, traceFlags, obj int TclCheckInterpTraces(interp, command, numChars, cmdPtr, code, traceFlags, objc, objv) Tcl_Interp *interp; /* The current interpreter. */ - char *command; /* Pointer to beginning of the current + CONST char *command; /* Pointer to beginning of the current * command string. */ int numChars; /* The number of characters in 'command' * which are part of the command string. */ @@ -4186,7 +4186,7 @@ CallTraceProcedure(interp, tracePtr, cmdPtr, command, numChars, objc, objv) Tcl_Interp *interp; /* The current interpreter. */ register Trace *tracePtr; /* Describes the trace procedure to call. */ Command *cmdPtr; /* Points to command's Command struct. */ - char *command; /* Points to the first character of the + CONST char *command; /* Points to the first character of the * command's source before substitutions. */ int numChars; /* The number of characters in the * command's source. */ @@ -4417,7 +4417,7 @@ static char * TraceVarProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Information about the variable trace. */ Tcl_Interp *interp; /* Interpreter containing variable. */ - char *name1; /* Name of variable or array. */ + CONST char *name1; /* Name of variable or array. */ CONST char *name2; /* Name of element within array; NULL means * scalar variable is being referenced. */ int flags; /* OR-ed bits giving operation and other diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 43d2146..680061e 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.31 2002/07/03 17:33:39 msofer Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.32 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -123,8 +123,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr) if (numWords > 2) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start, - valueTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -241,7 +241,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) { JumpFixup jumpFixup; Tcl_Token *cmdTokenPtr, *nameTokenPtr; - char *name; + CONST char *name; int localIndex, nameChars, range, startOffset, jumpDist; int code; int savedStackDepth = envPtr->currStackDepth; @@ -340,8 +340,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr) } } TclEmitOpcode(INST_POP, envPtr); - TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), - envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpFixup); /* @@ -669,7 +668,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) */ envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); code = TCL_OK; done: @@ -697,7 +696,7 @@ TclCompileForCmd(interp, parsePtr, envPtr) * Instructions are added to envPtr to execute the "foreach" command * at runtime. * - *---------------------------------------------------------------------- +n*---------------------------------------------------------------------- */ int @@ -716,16 +715,13 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) int loopCtTemp; /* Index of temp var holding the loop's * iteration count. */ Tcl_Token *tokenPtr, *bodyTokenPtr; - char *varList; unsigned char *jumpPc; JumpFixup jumpFalseFixup; int jumpDist, jumpBackDist, jumpBackOffset, infoIndex, range; int numWords, numLists, numVars, loopIndex, tempVar, i, j, code; - char savedChar; char buffer[32 + TCL_INTEGER_SPACE]; int savedStackDepth = envPtr->currStackDepth; - /* * We parse the variable list argument words and create two arrays: * varcList[i] is number of variables in i-th var list @@ -775,7 +771,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) numLists = (numWords - 2)/2; if (numLists > STATIC_VAR_LIST_SIZE) { varcList = (int *) ckalloc(numLists * sizeof(int)); - varvList = (CONST char ***) ckalloc(numLists * sizeof(char **)); + varvList = (CONST char ***) ckalloc(numLists * sizeof(CONST char **)); } for (loopIndex = 0; loopIndex < numLists; loopIndex++) { varcList[loopIndex] = 0; @@ -804,32 +800,29 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { code = TCL_OUT_LINE_COMPILE; goto done; - } - varList = tokenPtr[1].start; - savedChar = varList[tokenPtr[1].size]; + } else { + /* Lots of copying going on here. Need a ListObj wizard + * to show a better way. */ - /* - * Note there is a danger that modifying the string could have - * undesirable side effects. In this case, Tcl_SplitList does - * not have any dependencies on shared strings so we should be - * safe. - */ + Tcl_DString varList; - varList[tokenPtr[1].size] = '\0'; - code = Tcl_SplitList(interp, varList, - &varcList[loopIndex], &varvList[loopIndex]); - varList[tokenPtr[1].size] = savedChar; - if (code != TCL_OK) { - goto done; - } - - numVars = varcList[loopIndex]; - for (j = 0; j < numVars; j++) { - CONST char *varName = varvList[loopIndex][j]; - if (!TclIsLocalScalar(varName, (int) strlen(varName))) { - code = TCL_OUT_LINE_COMPILE; + Tcl_DStringInit(&varList); + Tcl_DStringAppend(&varList, tokenPtr[1].start, + tokenPtr[1].size); + code = Tcl_SplitList(interp, Tcl_DStringValue(&varList), + &varcList[loopIndex], &varvList[loopIndex]); + Tcl_DStringFree(&varList); + if (code != TCL_OK) { goto done; } + numVars = varcList[loopIndex]; + for (j = 0; j < numVars; j++) { + CONST char *varName = varvList[loopIndex][j]; + if (!TclIsLocalScalar(varName, (int) strlen(varName))) { + code = TCL_OUT_LINE_COMPILE; + goto done; + } + } } loopIndex++; } @@ -1004,14 +997,14 @@ TclCompileForeachCmd(interp, parsePtr, envPtr) */ envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); envPtr->currStackDepth = savedStackDepth + 1; done: for (loopIndex = 0; loopIndex < numLists; loopIndex++) { - if (varvList[loopIndex] != NULL) { - ckfree((char *) varvList[loopIndex]); - } + if (varvList[loopIndex] != (CONST char **) NULL) { + ckfree((char *) varvList[loopIndex]); + } } if (varcList != varcListStaticSpace) { ckfree((char *) varcList); @@ -1149,13 +1142,12 @@ TclCompileIfCmd(interp, parsePtr, envPtr) int jumpDist, jumpFalseDist; int jumpIndex = 0; /* avoid compiler warning. */ int numWords, wordIdx, numBytes, j, code; - char *word; + CONST char *word; char buffer[100]; int savedStackDepth = envPtr->currStackDepth; /* Saved stack depth at the start of the first * test; the envPtr current depth is restored * to this value at the start of each test. */ - char *condStart, *savedPos, savedChar; int realCond = 1; /* set to 0 for static conditions: "if 0 {..}" */ int boolVal; /* value of static condition */ int compileScripts = 1; @@ -1226,31 +1218,20 @@ TclCompileIfCmd(interp, parsePtr, envPtr) * Find out if the condition is a constant. */ - condStart = testTokenPtr[1].start; - savedPos = condStart + testTokenPtr[1].size - 1; - - while (*condStart == ' ') { - condStart++; - } - while (*savedPos == ' ') { - savedPos--; - } - savedPos++; - - savedChar = *savedPos; - *savedPos = '\0'; - - if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) { + Tcl_Obj *boolObj = Tcl_NewStringObj(testTokenPtr[1].start, + testTokenPtr[1].size); + Tcl_IncrRefCount(boolObj); + code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); + Tcl_DecrRefCount(boolObj); + if (code == TCL_OK) { /* * A static condition */ - *savedPos = savedChar; realCond = 0; if (!boolVal) { compileScripts = 0; } } else { - *savedPos = savedChar; Tcl_ResetResult(interp); code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (code != TCL_OK) { @@ -1438,7 +1419,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr) */ if (compileScripts) { - TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } } @@ -1546,9 +1527,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) if (parsePtr->numWords == 3) { incrTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (incrTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - char *word = incrTokenPtr[1].start; + CONST char *word = incrTokenPtr[1].start; int numBytes = incrTokenPtr[1].size; - char savedChar = word[numBytes]; + int validLength = TclParseInteger(word, numBytes); long n; /* @@ -1558,18 +1539,20 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) * should be safe. */ - word[numBytes] = '\0'; - if (TclLooksLikeInt(word, numBytes) - && (TclGetLong((Tcl_Interp *) NULL, word, &n) == TCL_OK)) { - if ((-127 <= n) && (n <= 127)) { + if (validLength == numBytes) { + int code; + Tcl_Obj *longObj = Tcl_NewStringObj(word, numBytes); + Tcl_IncrRefCount(longObj); + code = Tcl_GetLongFromObj(NULL, longObj, &n); + Tcl_DecrRefCount(longObj); + if ((code == TCL_OK) && (-127 <= n) && (n <= 127)) { haveImmValue = 1; immValue = n; } } - word[numBytes] = savedChar; if (!haveImmValue) { - TclEmitPush(TclRegisterLiteral(envPtr, word, numBytes, - /*onHeap*/ 0), envPtr); + TclEmitPush( + TclRegisterNewLiteral(envPtr, word, numBytes), envPtr); } } else { code = TclCompileTokens(interp, incrTokenPtr+1, @@ -1716,8 +1699,8 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) if (numWords > 2) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start, - valueTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -1732,7 +1715,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr) * always creates the variable. */ - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); numValues = 1; #endif } @@ -1826,11 +1809,9 @@ TclCompileLindexCmd(interp, parsePtr, envPtr) for ( i = 1 ; i < numWords ; i++ ) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush( TclRegisterLiteral( envPtr, - varTokenPtr[1].start, - varTokenPtr[1].size, - 0), - envPtr); + TclEmitPush( + TclRegisterNewLiteral( envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -1897,7 +1878,7 @@ TclCompileListCmd(interp, parsePtr, envPtr) * Empty args case */ - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } else { /* * Push the all values onto the stack. @@ -1911,9 +1892,8 @@ TclCompileListCmd(interp, parsePtr, envPtr) + (parsePtr->tokenPtr->numComponents + 1); for (i = 1; i < numWords; i++) { if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - valueTokenPtr[1].start, valueTokenPtr[1].size, - /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -1973,8 +1953,8 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr) * We could simply count the number of elements here and push * that value, but that is too rare a case to waste the code space. */ - TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start, - varTokenPtr[1].size, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2085,11 +2065,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr ) /* Push an arg */ if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush( TclRegisterLiteral( envPtr, - varTokenPtr[1].start, - varTokenPtr[1].size, - 0), - envPtr); + TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { result = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2219,7 +2196,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) Tcl_Token *varTokenPtr; /* Pointer to the Tcl_Token representing * the parse of the RE or string */ int i, len, code, exactMatch, nocase; - char c, *str; + Tcl_Obj *patternObj; + CONST char *str; /* * We are only interested in compiling simple regexp cases. @@ -2279,7 +2257,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) /* * The semantics of regexp are always match on re == "". */ - TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); return TCL_OK; } @@ -2317,16 +2295,17 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) } else { exactMatch = 0; } - c = str[len]; - str[len] = '\0'; - if (strpbrk(str, "*+?{}()[].\\|^$") != NULL) { - str[len] = c; + + patternObj = Tcl_NewStringObj(str, len); + Tcl_IncrRefCount(patternObj); + code = (strpbrk(Tcl_GetString(patternObj), "*+?{}()[].\\|^$") != NULL); + Tcl_DecrRefCount(patternObj); + if (code) { /* We don't do anything with REs with special chars yet. */ return TCL_OUT_LINE_COMPILE; } - str[len] = c; if (exactMatch) { - TclEmitPush(TclRegisterLiteral(envPtr, str, len, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, str, len), envPtr); } else { /* * This needs to find the substring anywhere in the string, so @@ -2337,7 +2316,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) strncpy(newStr + 1, str, (size_t) len); newStr[len+1] = '*'; newStr[len+2] = '\0'; - TclEmitPush(TclRegisterLiteral(envPtr, newStr, len+2, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, newStr, len+2), envPtr); ckfree((char *) newStr); } @@ -2346,8 +2325,8 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr) */ varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - varTokenPtr[1].start, varTokenPtr[1].size, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2412,7 +2391,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) * Simple case: [return] * Just push the literal string "". */ - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); break; } case 2: { @@ -2429,8 +2408,8 @@ TclCompileReturnCmd(interp, parsePtr, envPtr) * [return "foo"] case: the parse token is a simple word, * so just push it. */ - TclEmitPush(TclRegisterLiteral(envPtr, varTokenPtr[1].start, - varTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start, + varTokenPtr[1].size), envPtr); } else { /* * Parse token is more complex, so compile it; this handles the @@ -2532,8 +2511,8 @@ TclCompileSetCmd(interp, parsePtr, envPtr) if (isAssignment) { valueTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); if (valueTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, valueTokenPtr[1].start, - valueTokenPtr[1].size, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start, + valueTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, valueTokenPtr+1, valueTokenPtr->numComponents, envPtr); @@ -2695,9 +2674,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr) for (i = 0; i < 2; i++) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - varTokenPtr[1].start, varTokenPtr[1].size, - 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2726,9 +2704,8 @@ TclCompileStringCmd(interp, parsePtr, envPtr) for (i = 0; i < 2; i++) { if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - TclEmitPush(TclRegisterLiteral(envPtr, - varTokenPtr[1].start, varTokenPtr[1].size, - 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, + varTokenPtr[1].start, varTokenPtr[1].size), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2757,7 +2734,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) int len = Tcl_NumUtfChars(varTokenPtr[1].start, varTokenPtr[1].size); len = sprintf(buf, "%d", len); - TclEmitPush(TclRegisterLiteral(envPtr, buf, len, 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr); return TCL_OK; } else { code = TclCompileTokens(interp, varTokenPtr+1, @@ -2771,7 +2748,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr) } case STR_MATCH: { int i, length, exactMatch = 0, nocase = 0; - char c, *str; + CONST char *str; if (parsePtr->numWords < 4 || parsePtr->numWords > 5) { /* Fail at run time, not in compilation */ @@ -2803,18 +2780,19 @@ TclCompileStringCmd(interp, parsePtr, envPtr) * On the first (pattern) arg, check to see if any * glob special characters are in the word '*[]?\\'. * If not, this is the same as 'string equal'. We - * can use strchr here because the glob chars are all + * can use strpbrk here because the glob chars are all * in the ascii-7 range. If -nocase was specified, * we can't do this because INST_STR_EQ has no support * for nocase. */ - c = str[length]; - str[length] = '\0'; - exactMatch = (strpbrk(str, "*[]?\\") == NULL); - str[length] = c; + Tcl_Obj *copy = Tcl_NewStringObj(str, length); + Tcl_IncrRefCount(copy); + exactMatch = (strpbrk(Tcl_GetString(copy), + "*[]?\\") == NULL); + Tcl_DecrRefCount(copy); } - TclEmitPush(TclRegisterLiteral(envPtr, str, length, - 0), envPtr); + TclEmitPush( + TclRegisterNewLiteral(envPtr, str, length), envPtr); } else { code = TclCompileTokens(interp, varTokenPtr+1, varTokenPtr->numComponents, envPtr); @@ -2862,7 +2840,7 @@ TclCompileVariableCmd(interp, parsePtr, envPtr) { Tcl_Token *varTokenPtr; int i, numWords; - char *varName, *tail; + CONST char *varName, *tail; if (envPtr->procPtr == NULL) { return TCL_OUT_LINE_COMPILE; @@ -2929,9 +2907,8 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) int savedStackDepth = envPtr->currStackDepth; int loopMayEnd = 1; /* This is set to 0 if it is recognized as * an infinite loop. */ + Tcl_Obj *boolObj; int boolVal; - char *condStart; - char savedChar, *savedPos; if (parsePtr->numWords != 3) { Tcl_ResetResult(interp); @@ -2961,21 +2938,11 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * Find out if the condition is a constant. */ - condStart = testTokenPtr[1].start; - savedPos = condStart + testTokenPtr[1].size - 1; - - while (*condStart == ' ') { - condStart++; - } - while (*savedPos == ' ') { - savedPos--; - } - savedPos++; - - savedChar = *savedPos; - *savedPos = '\0'; - - if (Tcl_GetBoolean(interp, condStart, &boolVal) != TCL_ERROR) { + boolObj = Tcl_NewStringObj(testTokenPtr[1].start, testTokenPtr[1].size); + Tcl_IncrRefCount(boolObj); + code = Tcl_GetBooleanFromObj(NULL, boolObj, &boolVal); + Tcl_DecrRefCount(boolObj); + if (code == TCL_OK) { if (boolVal) { /* * it is an infinite loop @@ -2988,14 +2955,10 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) * Compile no bytecodes. */ - *savedPos = savedChar; goto pushResult; } - } else { - Tcl_ResetResult(interp); } - *savedPos = savedChar; - + /* * Create a ExceptionRange record for the loop body. This is used to * implement break and continue. @@ -3102,7 +3065,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr) pushResult: envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); envPtr->exceptDepth--; return TCL_OK; @@ -3145,11 +3108,14 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, { Tcl_Parse elemParse; int gotElemParse = 0; - register char *p; - char *name, *elName; + register CONST char *p; + CONST char *name, *elName; register int i, n; int nameChars, elNameChars, simpleVarName, localIndex; int code = TCL_OK; + Tcl_DString copy; + + Tcl_DStringInit(©); /* * Decide if we can use a frame slot for the var/array name or if we @@ -3273,8 +3239,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, } } if (localIndex < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars, - /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr); } /* @@ -3285,13 +3250,11 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, /* * Temporarily replace the '(' and ')' by '"'s. */ - - *(elName-1) = '"'; - *(elName+elNameChars) = '"'; - code = Tcl_ParseCommand(interp, elName-1, elNameChars+2, - /*nested*/ 0, &elemParse); - *(elName-1) = '('; - *(elName+elNameChars) = ')'; + Tcl_DStringAppend(©, "\"", 1); + Tcl_DStringAppend(©, elName, elNameChars); + Tcl_DStringAppend(©, "\"", 1); + code = Tcl_ParseCommand(interp, Tcl_DStringValue(©), + elNameChars+2, /*nested*/ 0, &elemParse); gotElemParse = 1; if ((code != TCL_OK) || (elemParse.numWords > 1)) { char buffer[160]; @@ -3307,8 +3270,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, goto done; } } else { - TclEmitPush(TclRegisterLiteral(envPtr, "", 0, - /*alreadyAlloced*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } } } else { @@ -3327,6 +3289,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, if (gotElemParse) { Tcl_FreeParse(&elemParse); } + Tcl_DStringFree(©); *localIndexPtr = localIndex; *simpleVarNamePtr = simpleVarName; *isScalarPtr = (elName == NULL); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index e51aa15..8d74efa 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.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: tclCompExpr.c,v 1.11 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.12 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -51,9 +51,9 @@ typedef struct ExprInfo { Tcl_Interp *interp; /* Used for error reporting. */ Tcl_Parse *parsePtr; /* Structure filled with information about * the parsed expression. */ - char *expr; /* The expression that was originally passed + CONST char *expr; /* The expression that was originally passed * to TclCompileExpr. */ - char *lastChar; /* Points just after last byte of expr. */ + CONST char *lastChar; /* Points just after last byte of expr. */ int hasOperators; /* Set 1 if the expr has operators; 0 if * expr is only a primary. If 1 after * compiling an expr, a tryCvtToNumeric @@ -156,7 +156,7 @@ static int CompileLandOrLorExpr _ANSI_ARGS_(( ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileMathFuncCall _ANSI_ARGS_(( - Tcl_Token *exprTokenPtr, char *funcName, + Tcl_Token *exprTokenPtr, CONST char *funcName, ExprInfo *infoPtr, CompileEnv *envPtr, Tcl_Token **endPtrPtr)); static int CompileSubExpr _ANSI_ARGS_(( @@ -203,7 +203,7 @@ static void LogSyntaxError _ANSI_ARGS_((ExprInfo *infoPtr)); int TclCompileExpr(interp, script, numBytes, envPtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *script; /* The source script to compile. */ + CONST char *script; /* The source script to compile. */ int numBytes; /* Number of bytes in script. If < 0, the * string consists of all bytes up to the * first null character. */ @@ -343,8 +343,8 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) Tcl_Token *tokenPtr, *endPtr, *afterSubexprPtr; OperatorDesc *opDescPtr; Tcl_HashEntry *hPtr; - char *operator; - char savedChar; + CONST char *operator; + Tcl_DString opBuf; int objIndex, opIndex, length, code; char buffer[TCL_UTF_MAX]; @@ -375,10 +375,10 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) case TCL_TOKEN_TEXT: if (tokenPtr->size > 0) { - objIndex = TclRegisterLiteral(envPtr, tokenPtr->start, - tokenPtr->size, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, tokenPtr->start, + tokenPtr->size); } else { - objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, "", 0); } TclEmitPush(objIndex, envPtr); tokenPtr += 1; @@ -388,10 +388,9 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer); if (length > 0) { - objIndex = TclRegisterLiteral(envPtr, buffer, length, - /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, buffer, length); } else { - objIndex = TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, "", 0); } TclEmitPush(objIndex, envPtr); tokenPtr += 1; @@ -424,33 +423,24 @@ CompileSubExpr(exprTokenPtr, infoPtr, envPtr) case TCL_TOKEN_OPERATOR: /* - * Look up the operator. Temporarily overwrite the character - * just after the end of the operator with a 0 byte. If the - * operator isn't found, treat it as a math function. + * Look up the operator. If the operator isn't found, treat it + * as a math function. */ - - /* - * TODO: Note that the string is modified in place. This is unsafe - * and will break if any of the routines called while the string is - * modified have side effects that depend on the original string - * being unmodified (e.g. adding an entry to the literal table). - */ - - operator = tokenPtr->start; - savedChar = operator[tokenPtr->size]; - operator[tokenPtr->size] = 0; + Tcl_DStringInit(&opBuf); + operator = Tcl_DStringAppend(&opBuf, + tokenPtr->start, tokenPtr->size); hPtr = Tcl_FindHashEntry(&opHashTable, operator); if (hPtr == NULL) { code = CompileMathFuncCall(exprTokenPtr, operator, infoPtr, envPtr, &endPtr); - operator[tokenPtr->size] = (char) savedChar; + Tcl_DStringFree(&opBuf); if (code != TCL_OK) { goto done; } tokenPtr = endPtr; break; } - operator[tokenPtr->size] = (char) savedChar; + Tcl_DStringFree(&opBuf); opIndex = (int) Tcl_GetHashValue(hPtr); opDescPtr = &(operatorTable[opIndex]); @@ -627,7 +617,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) */ TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &lhsTrueFixup); - TclEmitPush(TclRegisterLiteral(envPtr, "0", 1, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "0", 1), envPtr); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &lhsEndFixup); dist = (envPtr->codeNext - envPtr->codeStart) - lhsTrueFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsTrueFixup, dist, 127)) { @@ -635,7 +625,7 @@ CompileLandOrLorExpr(exprTokenPtr, opIndex, infoPtr, envPtr, endPtrPtr) panic("CompileLandOrLorExpr: bad jump distance %d\n", dist); } envPtr->currStackDepth = savedStackDepth; - TclEmitPush(TclRegisterLiteral(envPtr, "1", 1, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, "1", 1), envPtr); dist = (envPtr->codeNext - envPtr->codeStart) - lhsEndFixup.codeOffset; if (TclFixupForwardJump(envPtr, &lhsEndFixup, dist, 127)) { goto badDist; @@ -836,7 +826,7 @@ static int CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) Tcl_Token *exprTokenPtr; /* Points to TCL_TOKEN_SUB_EXPR token * containing the math function call. */ - char *funcName; /* Name of the math function. */ + CONST char *funcName; /* Name of the math function. */ ExprInfo *infoPtr; /* Describes the compilation state for the * expression being compiled. */ CompileEnv *envPtr; /* Holds resulting instructions. */ @@ -870,8 +860,7 @@ CompileMathFuncCall(exprTokenPtr, funcName, infoPtr, envPtr, endPtrPtr) */ if (mathFuncPtr->builtinFuncIndex < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0), - envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr); } /* diff --git a/generic/tclCompile.c b/generic/tclCompile.c index dc2aa25..75f253e 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.c,v 1.39 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.40 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -292,7 +292,8 @@ static void FreeByteCodeInternalRep _ANSI_ARGS_(( static int GetCmdLocEncodingSize _ANSI_ARGS_(( CompileEnv *envPtr)); static void LogCompilationInfo _ANSI_ARGS_((Tcl_Interp *interp, - char *script, char *command, int length)); + CONST char *script, CONST char *command, + int length)); #ifdef TCL_COMPILE_STATS static void RecordByteCodeStats _ANSI_ARGS_(( ByteCode *codePtr)); @@ -798,7 +799,7 @@ TclFreeCompileEnv(envPtr) int TclCompileScript(interp, script, numBytes, nested, envPtr) Tcl_Interp *interp; /* Used for error and status reporting. */ - char *script; /* The source script to compile. */ + CONST char *script; /* The source script to compile. */ int numBytes; /* Number of bytes in script. If < 0, the * script consists of all bytes up to the * first null character. */ @@ -817,7 +818,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) int startCodeOffset = -1; /* Offset of first byte of current command's * code. Init. to avoid compiler warning. */ unsigned char *entryCodeNext = envPtr->codeNext; - char *p, *next; + CONST char *p, *next; Namespace *cmdNsPtr; Command *cmdPtr; Tcl_Token *tokenPtr; @@ -972,18 +973,16 @@ TclCompileScript(interp, script, numBytes, nested, envPtr) * reduce runtime lookups. */ - objIndex = TclRegisterLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size, - /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); if (cmdPtr != NULL) { TclSetCmdNameObj(interp, envPtr->literalArrayPtr[objIndex].objPtr, cmdPtr); } } else { - objIndex = TclRegisterLiteral(envPtr, - tokenPtr[1].start, tokenPtr[1].size, - /*onHeap*/ 0); + objIndex = TclRegisterNewLiteral(envPtr, + tokenPtr[1].start, tokenPtr[1].size); } TclEmitPush(objIndex, envPtr); } else { @@ -1127,7 +1126,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr) Tcl_DString textBuffer; /* Holds concatenated chars from adjacent * TCL_TOKEN_TEXT, TCL_TOKEN_BS tokens. */ char buffer[TCL_UTF_MAX]; - char *name, *p; + CONST char *name, *p; int numObjsToConcat, nameBytes, localVarName, localVar; int length, i, code; unsigned char *entryCodeNext = envPtr->codeNext; @@ -1225,8 +1224,8 @@ TclCompileTokens(interp, tokenPtr, count, envPtr) localVarName, /*flags*/ 0, envPtr->procPtr); } if (localVar < 0) { - TclEmitPush(TclRegisterLiteral(envPtr, name, - nameBytes, /*onHeap*/ 0), envPtr); + TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes), + envPtr); } /* @@ -1406,7 +1405,7 @@ TclCompileExprWords(interp, tokenPtr, numWords, envPtr) { Tcl_Token *wordPtr; int range, numBytes, i, code; - char *script; + CONST char *script; range = -1; code = TCL_OK; @@ -1639,15 +1638,15 @@ static void LogCompilationInfo(interp, script, command, length) Tcl_Interp *interp; /* Interpreter in which to log the * information. */ - char *script; /* First character in script containing + CONST char *script; /* First character in script containing * command (must be <= command). */ - char *command; /* First character in command that + CONST char *command; /* First character in command that * generated the error. */ int length; /* Number of bytes in command (-1 means * use all bytes up to first null byte). */ { char buffer[200]; - register char *p; + register CONST char *p; char *ellipsis = ""; Interp *iPtr = (Interp *) interp; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index e6c2740..88fe81d 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.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: tclCompile.h,v 1.29 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.30 2002/08/05 03:24:40 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -724,7 +724,7 @@ extern AuxDataType tclForeachInfoType; */ EXTERN int TclEvalObjvInternal _ANSI_ARGS_((Tcl_Interp *interp, int objc, - Tcl_Obj *CONST objv[], char *command, int length, + Tcl_Obj *CONST objv[], CONST char *command, int length, int flags)); EXTERN int TclInterpReady _ANSI_ARGS_((Tcl_Interp *interp)); @@ -750,13 +750,13 @@ EXTERN int TclCompileCmdWord _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, CompileEnv *envPtr)); EXTERN int TclCompileExpr _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int numBytes, + CONST char *script, int numBytes, CompileEnv *envPtr)); EXTERN int TclCompileExprWords _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int numWords, CompileEnv *envPtr)); EXTERN int TclCompileScript _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int numBytes, int nested, + CONST char *script, int numBytes, int nested, CompileEnv *envPtr)); EXTERN int TclCompileTokens _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, int count, @@ -836,6 +836,15 @@ EXTERN void TclVerifyLocalLiteralTable _ANSI_ARGS_(( */ /* + * Form of TclRegisterLiteral with onHeap == 0. + * In that case, it is safe to cast away CONSTness, and it + * is cleanest to do that here, all in one place. + */ + +#define TclRegisterNewLiteral(envPtr, bytes, length) \ + TclRegisterLiteral(envPtr, (char *)(bytes), length, /*onHeap*/ 0) + +/* * Macro used to update the stack requirements. * It is called by the macros TclEmitOpCode, TclEmitInst1 and * TclEmitInst4. diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 19687a3..a0a8b4b 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.91 2002/07/22 16:51:48 vincentdarley Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.92 2002/08/05 03:24:40 dgp Exp $ */ #ifndef _TCLDECLS @@ -31,9 +31,10 @@ EXTERN int Tcl_PkgProvideEx _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 1 */ -EXTERN CONST char * Tcl_PkgRequireEx _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * name, CONST char * version, - int exact, ClientData * clientDataPtr)); +EXTERN CONST84_RETURN char * Tcl_PkgRequireEx _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * name, + CONST char * version, int exact, + ClientData * clientDataPtr)); /* 2 */ EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 3 */ @@ -271,9 +272,9 @@ EXTERN void Tcl_CancelIdleCall _ANSI_ARGS_(( EXTERN int Tcl_Close _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 82 */ -EXTERN int Tcl_CommandComplete _ANSI_ARGS_((char * cmd)); +EXTERN int Tcl_CommandComplete _ANSI_ARGS_((CONST char * cmd)); /* 83 */ -EXTERN char * Tcl_Concat _ANSI_ARGS_((int argc, +EXTERN CONST84_RETURN char * Tcl_Concat _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 84 */ EXTERN int Tcl_ConvertElement _ANSI_ARGS_((CONST char * src, @@ -286,7 +287,7 @@ EXTERN int Tcl_ConvertCountedElement _ANSI_ARGS_(( EXTERN int Tcl_CreateAlias _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, - char * CONST * argv)); + CONST84 char * CONST * argv)); /* 87 */ EXTERN int Tcl_CreateAliasObj _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, @@ -430,12 +431,12 @@ EXTERN void Tcl_DStringStartSublist _ANSI_ARGS_(( /* 126 */ EXTERN int Tcl_Eof _ANSI_ARGS_((Tcl_Channel chan)); /* 127 */ -EXTERN CONST char * Tcl_ErrnoId _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * Tcl_ErrnoId _ANSI_ARGS_((void)); /* 128 */ -EXTERN CONST char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); +EXTERN CONST84_RETURN char * Tcl_ErrnoMsg _ANSI_ARGS_((int err)); /* 129 */ EXTERN int Tcl_Eval _ANSI_ARGS_((Tcl_Interp * interp, - char * string)); + CONST char * string)); /* 130 */ EXTERN int Tcl_EvalFile _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); @@ -493,7 +494,7 @@ EXTERN int Tcl_GetAlias _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, - char *** argvPtr)); + CONST84 char *** argvPtr)); /* 149 */ EXTERN int Tcl_GetAliasObj _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, @@ -519,7 +520,8 @@ EXTERN ClientData Tcl_GetChannelInstanceData _ANSI_ARGS_(( /* 155 */ EXTERN int Tcl_GetChannelMode _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ -EXTERN CONST char * Tcl_GetChannelName _ANSI_ARGS_((Tcl_Channel chan)); +EXTERN CONST84_RETURN char * Tcl_GetChannelName _ANSI_ARGS_(( + Tcl_Channel chan)); /* 157 */ EXTERN int Tcl_GetChannelOption _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan, @@ -530,12 +532,12 @@ EXTERN Tcl_ChannelType * Tcl_GetChannelType _ANSI_ARGS_((Tcl_Channel chan)); EXTERN int Tcl_GetCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 160 */ -EXTERN CONST char * Tcl_GetCommandName _ANSI_ARGS_((Tcl_Interp * interp, - Tcl_Command command)); +EXTERN CONST84_RETURN char * Tcl_GetCommandName _ANSI_ARGS_(( + Tcl_Interp * interp, Tcl_Command command)); /* 161 */ EXTERN int Tcl_GetErrno _ANSI_ARGS_((void)); /* 162 */ -EXTERN CONST char * Tcl_GetHostName _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * Tcl_GetHostName _ANSI_ARGS_((void)); /* 163 */ EXTERN int Tcl_GetInterpPath _ANSI_ARGS_(( Tcl_Interp * askInterp, @@ -568,16 +570,18 @@ EXTERN Tcl_Interp * Tcl_GetSlave _ANSI_ARGS_((Tcl_Interp * interp, /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel _ANSI_ARGS_((int type)); /* 174 */ -EXTERN CONST char * Tcl_GetStringResult _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN CONST84_RETURN char * Tcl_GetStringResult _ANSI_ARGS_(( + Tcl_Interp * interp)); /* 175 */ -EXTERN CONST char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags)); +EXTERN CONST84_RETURN char * Tcl_GetVar _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * varName, int flags)); /* 176 */ -EXTERN CONST char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags)); +EXTERN CONST84_RETURN char * Tcl_GetVar2 _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * part1, CONST char * part2, + int flags)); /* 177 */ EXTERN int Tcl_GlobalEval _ANSI_ARGS_((Tcl_Interp * interp, - char * command)); + CONST char * command)); /* 178 */ EXTERN int Tcl_GlobalEvalObj _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); @@ -604,7 +608,7 @@ EXTERN char * Tcl_JoinPath _ANSI_ARGS_((int argc, Tcl_DString * resultPtr)); /* 187 */ EXTERN int Tcl_LinkVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, char * addr, int type)); + CONST char * varName, char * addr, int type)); /* Slot 188 is reserved */ /* 189 */ EXTERN Tcl_Channel Tcl_MakeFileChannel _ANSI_ARGS_((ClientData handle, @@ -664,7 +668,7 @@ EXTERN void Tcl_PrintDouble _ANSI_ARGS_((Tcl_Interp * interp, /* 203 */ EXTERN int Tcl_PutEnv _ANSI_ARGS_((CONST char * string)); /* 204 */ -EXTERN CONST char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp)); +EXTERN CONST84_RETURN char * Tcl_PosixError _ANSI_ARGS_((Tcl_Interp * interp)); /* 205 */ EXTERN void Tcl_QueueEvent _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); @@ -767,17 +771,17 @@ EXTERN void Tcl_SetObjResult _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void Tcl_SetStdChannel _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 237 */ -EXTERN CONST char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, CONST char * newValue, +EXTERN CONST84_RETURN char * Tcl_SetVar _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * varName, CONST char * newValue, int flags)); /* 238 */ -EXTERN CONST char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, +EXTERN CONST84_RETURN char * Tcl_SetVar2 _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 239 */ -EXTERN CONST char * Tcl_SignalId _ANSI_ARGS_((int sig)); +EXTERN CONST84_RETURN char * Tcl_SignalId _ANSI_ARGS_((int sig)); /* 240 */ -EXTERN CONST char * Tcl_SignalMsg _ANSI_ARGS_((int sig)); +EXTERN CONST84_RETURN char * Tcl_SignalMsg _ANSI_ARGS_((int sig)); /* 241 */ EXTERN void Tcl_SourceRCFile _ANSI_ARGS_((Tcl_Interp * interp)); /* 242 */ @@ -799,13 +803,13 @@ EXTERN int Tcl_StringMatch _ANSI_ARGS_((CONST char * str, EXTERN int Tcl_TellOld _ANSI_ARGS_((Tcl_Channel chan)); /* 247 */ EXTERN int Tcl_TraceVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags, + CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ EXTERN int Tcl_TraceVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - Tcl_VarTraceProc * proc, + CONST char * part1, CONST char * part2, + int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 249 */ EXTERN char * Tcl_TranslateFileName _ANSI_ARGS_(( @@ -816,49 +820,50 @@ EXTERN int Tcl_Ungets _ANSI_ARGS_((Tcl_Channel chan, CONST char * str, int len, int atHead)); /* 251 */ EXTERN void Tcl_UnlinkVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName)); + CONST char * varName)); /* 252 */ EXTERN int Tcl_UnregisterChannel _ANSI_ARGS_(( Tcl_Interp * interp, Tcl_Channel chan)); /* 253 */ EXTERN int Tcl_UnsetVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags)); + CONST char * varName, int flags)); /* 254 */ EXTERN int Tcl_UnsetVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags)); + CONST char * part1, CONST char * part2, + int flags)); /* 255 */ EXTERN void Tcl_UntraceVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags, + CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ EXTERN void Tcl_UntraceVar2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - Tcl_VarTraceProc * proc, + CONST char * part1, CONST char * part2, + int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 257 */ EXTERN void Tcl_UpdateLinkedVar _ANSI_ARGS_((Tcl_Interp * interp, - char * varName)); + CONST char * varName)); /* 258 */ EXTERN int Tcl_UpVar _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * frameName, char * varName, + CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 259 */ EXTERN int Tcl_UpVar2 _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * frameName, char * part1, + CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 260 */ EXTERN int Tcl_VarEval _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 261 */ EXTERN ClientData Tcl_VarTraceInfo _ANSI_ARGS_((Tcl_Interp * interp, - char * varName, int flags, + CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ EXTERN ClientData Tcl_VarTraceInfo2 _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - Tcl_VarTraceProc * procPtr, + CONST char * part1, CONST char * part2, + int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 263 */ EXTERN int Tcl_Write _ANSI_ARGS_((Tcl_Channel chan, @@ -880,23 +885,25 @@ EXTERN void Tcl_AppendResultVA _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void Tcl_AppendStringsToObjVA _ANSI_ARGS_(( Tcl_Obj * objPtr, va_list argList)); /* 269 */ -EXTERN CONST char * Tcl_HashStats _ANSI_ARGS_((Tcl_HashTable * tablePtr)); +EXTERN CONST84_RETURN char * Tcl_HashStats _ANSI_ARGS_(( + Tcl_HashTable * tablePtr)); /* 270 */ -EXTERN CONST char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, - char * str, char ** termPtr)); +EXTERN CONST84_RETURN char * Tcl_ParseVar _ANSI_ARGS_((Tcl_Interp * interp, + CONST char * str, CONST84 char ** termPtr)); /* 271 */ -EXTERN CONST char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN CONST84_RETURN char * Tcl_PkgPresent _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 272 */ -EXTERN CONST char * Tcl_PkgPresentEx _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * name, CONST char * version, - int exact, ClientData * clientDataPtr)); +EXTERN CONST84_RETURN char * Tcl_PkgPresentEx _ANSI_ARGS_(( + Tcl_Interp * interp, CONST char * name, + CONST char * version, int exact, + ClientData * clientDataPtr)); /* 273 */ EXTERN int Tcl_PkgProvide _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 274 */ -EXTERN CONST char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN CONST84_RETURN char * Tcl_PkgRequire _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 275 */ @@ -946,7 +953,7 @@ EXTERN void Tcl_DiscardResult _ANSI_ARGS_(( Tcl_SavedResult * statePtr)); /* 291 */ EXTERN int Tcl_EvalEx _ANSI_ARGS_((Tcl_Interp * interp, - char * script, int numBytes, int flags)); + CONST char * script, int numBytes, int flags)); /* 292 */ EXTERN int Tcl_EvalObjv _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); @@ -979,7 +986,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread _ANSI_ARGS_((void)); EXTERN Tcl_Encoding Tcl_GetEncoding _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 302 */ -EXTERN CONST char * Tcl_GetEncodingName _ANSI_ARGS_(( +EXTERN CONST84_RETURN char * Tcl_GetEncodingName _ANSI_ARGS_(( Tcl_Encoding encoding)); /* 303 */ EXTERN void Tcl_GetEncodingNames _ANSI_ARGS_(( @@ -994,7 +1001,8 @@ EXTERN VOID * Tcl_GetThreadData _ANSI_ARGS_(( Tcl_ThreadDataKey * keyPtr, int size)); /* 306 */ EXTERN Tcl_Obj * Tcl_GetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags)); + CONST char * part1, CONST char * part2, + int flags)); /* 307 */ EXTERN ClientData Tcl_InitNotifier _ANSI_ARGS_((void)); /* 308 */ @@ -1026,7 +1034,7 @@ EXTERN int Tcl_SetSystemEncoding _ANSI_ARGS_(( Tcl_Interp * interp, CONST char * name)); /* 317 */ EXTERN Tcl_Obj * Tcl_SetVar2Ex _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, + CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 318 */ EXTERN void Tcl_ThreadAlert _ANSI_ARGS_((Tcl_ThreadId threadId)); @@ -1046,7 +1054,7 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper _ANSI_ARGS_((int ch)); /* 324 */ EXTERN int Tcl_UniCharToUtf _ANSI_ARGS_((int ch, char * buf)); /* 325 */ -EXTERN CONST char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfAtIndex _ANSI_ARGS_((CONST char * src, int index)); /* 326 */ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, @@ -1055,15 +1063,15 @@ EXTERN int Tcl_UtfCharComplete _ANSI_ARGS_((CONST char * src, EXTERN int Tcl_UtfBackslash _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 328 */ -EXTERN CONST char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfFindFirst _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ -EXTERN CONST char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfFindLast _ANSI_ARGS_((CONST char * src, int ch)); /* 330 */ -EXTERN CONST char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src)); +EXTERN CONST84_RETURN char * Tcl_UtfNext _ANSI_ARGS_((CONST char * src)); /* 331 */ -EXTERN CONST char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src, +EXTERN CONST84_RETURN char * Tcl_UtfPrev _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 332 */ EXTERN int Tcl_UtfToExternal _ANSI_ARGS_((Tcl_Interp * interp, @@ -1094,7 +1102,7 @@ EXTERN int Tcl_WriteObj _ANSI_ARGS_((Tcl_Channel chan, /* 340 */ EXTERN char * Tcl_GetString _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 341 */ -EXTERN CONST char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir _ANSI_ARGS_((void)); /* 342 */ EXTERN void Tcl_SetDefaultEncodingDir _ANSI_ARGS_(( CONST char * path)); @@ -1144,25 +1152,25 @@ EXTERN void Tcl_LogCommandInfo _ANSI_ARGS_((Tcl_Interp * interp, int length)); /* 360 */ EXTERN int Tcl_ParseBraces _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, + CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, - char ** termPtr)); + CONST84 char ** termPtr)); /* 361 */ EXTERN int Tcl_ParseCommand _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, int nested, - Tcl_Parse * parsePtr)); + CONST char * string, int numBytes, + int nested, Tcl_Parse * parsePtr)); /* 362 */ EXTERN int Tcl_ParseExpr _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, + CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 363 */ EXTERN int Tcl_ParseQuotedString _ANSI_ARGS_(( - Tcl_Interp * interp, char * string, + Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, - int append, char ** termPtr)); + int append, CONST84 char ** termPtr)); /* 364 */ EXTERN int Tcl_ParseVarName _ANSI_ARGS_((Tcl_Interp * interp, - char * string, int numBytes, + CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 365 */ EXTERN char * Tcl_GetCwd _ANSI_ARGS_((Tcl_Interp * interp, @@ -1255,7 +1263,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */ EXTERN int Tcl_ChannelBuffered _ANSI_ARGS_((Tcl_Channel chan)); /* 398 */ -EXTERN CONST char * Tcl_ChannelName _ANSI_ARGS_(( +EXTERN CONST84_RETURN char * Tcl_ChannelName _ANSI_ARGS_(( Tcl_ChannelType * chanTypePtr)); /* 399 */ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion _ANSI_ARGS_(( @@ -1568,7 +1576,7 @@ typedef struct TclStubs { struct TclStubHooks *hooks; int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */ - CONST char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */ + CONST84_RETURN char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */ void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */ char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */ void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */ @@ -1665,11 +1673,11 @@ typedef struct TclStubs { void (*tcl_CallWhenDeleted) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_InterpDeleteProc * proc, ClientData clientData)); /* 79 */ void (*tcl_CancelIdleCall) _ANSI_ARGS_((Tcl_IdleProc * idleProc, ClientData clientData)); /* 80 */ int (*tcl_Close) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 81 */ - int (*tcl_CommandComplete) _ANSI_ARGS_((char * cmd)); /* 82 */ - char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */ + int (*tcl_CommandComplete) _ANSI_ARGS_((CONST char * cmd)); /* 82 */ + CONST84_RETURN char * (*tcl_Concat) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv)); /* 83 */ int (*tcl_ConvertElement) _ANSI_ARGS_((CONST char * src, char * dst, int flags)); /* 84 */ int (*tcl_ConvertCountedElement) _ANSI_ARGS_((CONST char * src, int length, char * dst, int flags)); /* 85 */ - int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, char * CONST * argv)); /* 86 */ + int (*tcl_CreateAlias) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int argc, CONST84 char * CONST * argv)); /* 86 */ int (*tcl_CreateAliasObj) _ANSI_ARGS_((Tcl_Interp * slave, CONST char * slaveCmd, Tcl_Interp * target, CONST char * targetCmd, int objc, Tcl_Obj *CONST objv[])); /* 87 */ Tcl_Channel (*tcl_CreateChannel) _ANSI_ARGS_((Tcl_ChannelType * typePtr, CONST char * chanName, ClientData instanceData, int mask)); /* 88 */ void (*tcl_CreateChannelHandler) _ANSI_ARGS_((Tcl_Channel chan, int mask, Tcl_ChannelProc * proc, ClientData clientData)); /* 89 */ @@ -1718,9 +1726,9 @@ typedef struct TclStubs { void (*tcl_DStringSetLength) _ANSI_ARGS_((Tcl_DString * dsPtr, int length)); /* 124 */ void (*tcl_DStringStartSublist) _ANSI_ARGS_((Tcl_DString * dsPtr)); /* 125 */ int (*tcl_Eof) _ANSI_ARGS_((Tcl_Channel chan)); /* 126 */ - CONST char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ - CONST char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ - int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, char * string)); /* 129 */ + CONST84_RETURN char * (*tcl_ErrnoId) _ANSI_ARGS_((void)); /* 127 */ + CONST84_RETURN char * (*tcl_ErrnoMsg) _ANSI_ARGS_((int err)); /* 128 */ + int (*tcl_Eval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 129 */ int (*tcl_EvalFile) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * fileName)); /* 130 */ int (*tcl_EvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 131 */ void (*tcl_EventuallyFree) _ANSI_ARGS_((ClientData clientData, Tcl_FreeProc * freeProc)); /* 132 */ @@ -1739,7 +1747,7 @@ typedef struct TclStubs { Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */ int (*tcl_Flush) _ANSI_ARGS_((Tcl_Channel chan)); /* 146 */ void (*tcl_FreeResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 147 */ - int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, char *** argvPtr)); /* 148 */ + int (*tcl_GetAlias) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * argcPtr, CONST84 char *** argvPtr)); /* 148 */ int (*tcl_GetAliasObj) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveCmd, Tcl_Interp ** targetInterpPtr, CONST84 char ** targetCmdPtr, int * objcPtr, Tcl_Obj *** objv)); /* 149 */ ClientData (*tcl_GetAssocData) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_InterpDeleteProc ** procPtr)); /* 150 */ Tcl_Channel (*tcl_GetChannel) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * chanName, int * modePtr)); /* 151 */ @@ -1747,13 +1755,13 @@ typedef struct TclStubs { int (*tcl_GetChannelHandle) _ANSI_ARGS_((Tcl_Channel chan, int direction, ClientData * handlePtr)); /* 153 */ ClientData (*tcl_GetChannelInstanceData) _ANSI_ARGS_((Tcl_Channel chan)); /* 154 */ int (*tcl_GetChannelMode) _ANSI_ARGS_((Tcl_Channel chan)); /* 155 */ - CONST char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ + CONST84_RETURN char * (*tcl_GetChannelName) _ANSI_ARGS_((Tcl_Channel chan)); /* 156 */ int (*tcl_GetChannelOption) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, CONST char * optionName, Tcl_DString * dsPtr)); /* 157 */ Tcl_ChannelType * (*tcl_GetChannelType) _ANSI_ARGS_((Tcl_Channel chan)); /* 158 */ int (*tcl_GetCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, Tcl_CmdInfo * infoPtr)); /* 159 */ - CONST char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */ + CONST84_RETURN char * (*tcl_GetCommandName) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Command command)); /* 160 */ int (*tcl_GetErrno) _ANSI_ARGS_((void)); /* 161 */ - CONST char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */ + CONST84_RETURN char * (*tcl_GetHostName) _ANSI_ARGS_((void)); /* 162 */ int (*tcl_GetInterpPath) _ANSI_ARGS_((Tcl_Interp * askInterp, Tcl_Interp * slaveInterp)); /* 163 */ Tcl_Interp * (*tcl_GetMaster) _ANSI_ARGS_((Tcl_Interp * interp)); /* 164 */ CONST char * (*tcl_GetNameOfExecutable) _ANSI_ARGS_((void)); /* 165 */ @@ -1773,10 +1781,10 @@ typedef struct TclStubs { int (*tcl_GetServiceMode) _ANSI_ARGS_((void)); /* 171 */ Tcl_Interp * (*tcl_GetSlave) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * slaveName)); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) _ANSI_ARGS_((int type)); /* 173 */ - CONST char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */ - CONST char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 175 */ - CONST char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 176 */ - int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, char * command)); /* 177 */ + CONST84_RETURN char * (*tcl_GetStringResult) _ANSI_ARGS_((Tcl_Interp * interp)); /* 174 */ + CONST84_RETURN char * (*tcl_GetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 175 */ + CONST84_RETURN char * (*tcl_GetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 176 */ + int (*tcl_GlobalEval) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command)); /* 177 */ int (*tcl_GlobalEvalObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr)); /* 178 */ int (*tcl_HideCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * cmdName, CONST char * hiddenCmdToken)); /* 179 */ int (*tcl_Init) _ANSI_ARGS_((Tcl_Interp * interp)); /* 180 */ @@ -1786,7 +1794,7 @@ typedef struct TclStubs { int (*tcl_InterpDeleted) _ANSI_ARGS_((Tcl_Interp * interp)); /* 184 */ int (*tcl_IsSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 185 */ char * (*tcl_JoinPath) _ANSI_ARGS_((int argc, CONST84 char * CONST * argv, Tcl_DString * resultPtr)); /* 186 */ - int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, char * addr, int type)); /* 187 */ + int (*tcl_LinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, char * addr, int type)); /* 187 */ void *reserved188; Tcl_Channel (*tcl_MakeFileChannel) _ANSI_ARGS_((ClientData handle, int mode)); /* 189 */ int (*tcl_MakeSafe) _ANSI_ARGS_((Tcl_Interp * interp)); /* 190 */ @@ -1811,7 +1819,7 @@ typedef struct TclStubs { void (*tcl_Preserve) _ANSI_ARGS_((ClientData data)); /* 201 */ void (*tcl_PrintDouble) _ANSI_ARGS_((Tcl_Interp * interp, double value, char * dst)); /* 202 */ int (*tcl_PutEnv) _ANSI_ARGS_((CONST char * string)); /* 203 */ - CONST char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ + CONST84_RETURN char * (*tcl_PosixError) _ANSI_ARGS_((Tcl_Interp * interp)); /* 204 */ void (*tcl_QueueEvent) _ANSI_ARGS_((Tcl_Event * evPtr, Tcl_QueuePosition position)); /* 205 */ int (*tcl_Read) _ANSI_ARGS_((Tcl_Channel chan, char * bufPtr, int toRead)); /* 206 */ #if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */ @@ -1852,44 +1860,44 @@ typedef struct TclStubs { void (*tcl_SetObjErrorCode) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * errorObjPtr)); /* 234 */ void (*tcl_SetObjResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * resultObjPtr)); /* 235 */ void (*tcl_SetStdChannel) _ANSI_ARGS_((Tcl_Channel channel, int type)); /* 236 */ - CONST char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, CONST char * newValue, int flags)); /* 237 */ - CONST char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */ - CONST char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */ - CONST char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */ + CONST84_RETURN char * (*tcl_SetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, CONST char * newValue, int flags)); /* 237 */ + CONST84_RETURN char * (*tcl_SetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, CONST char * newValue, int flags)); /* 238 */ + CONST84_RETURN char * (*tcl_SignalId) _ANSI_ARGS_((int sig)); /* 239 */ + CONST84_RETURN char * (*tcl_SignalMsg) _ANSI_ARGS_((int sig)); /* 240 */ void (*tcl_SourceRCFile) _ANSI_ARGS_((Tcl_Interp * interp)); /* 241 */ int (*tcl_SplitList) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * listStr, int * argcPtr, CONST84 char *** argvPtr)); /* 242 */ void (*tcl_SplitPath) _ANSI_ARGS_((CONST char * path, int * argcPtr, CONST84 char *** argvPtr)); /* 243 */ void (*tcl_StaticPackage) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * pkgName, Tcl_PackageInitProc * initProc, Tcl_PackageInitProc * safeInitProc)); /* 244 */ int (*tcl_StringMatch) _ANSI_ARGS_((CONST char * str, CONST char * pattern)); /* 245 */ int (*tcl_TellOld) _ANSI_ARGS_((Tcl_Channel chan)); /* 246 */ - int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */ - int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ + int (*tcl_TraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 247 */ + int (*tcl_TraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 248 */ char * (*tcl_TranslateFileName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, Tcl_DString * bufferPtr)); /* 249 */ int (*tcl_Ungets) _ANSI_ARGS_((Tcl_Channel chan, CONST char * str, int len, int atHead)); /* 250 */ - void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 251 */ + void (*tcl_UnlinkVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 251 */ int (*tcl_UnregisterChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan)); /* 252 */ - int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags)); /* 253 */ - int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 254 */ - void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */ - void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ - void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 257 */ - int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * varName, CONST char * localName, int flags)); /* 258 */ - int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */ + int (*tcl_UnsetVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags)); /* 253 */ + int (*tcl_UnsetVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 254 */ + void (*tcl_UntraceVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 255 */ + void (*tcl_UntraceVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * proc, ClientData clientData)); /* 256 */ + void (*tcl_UpdateLinkedVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 257 */ + int (*tcl_UpVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * varName, CONST char * localName, int flags)); /* 258 */ + int (*tcl_UpVar2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * frameName, CONST char * part1, CONST char * part2, CONST char * localName, int flags)); /* 259 */ int (*tcl_VarEval) _ANSI_ARGS_(TCL_VARARGS(Tcl_Interp *,interp)); /* 260 */ - ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */ - ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ + ClientData (*tcl_VarTraceInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 261 */ + ClientData (*tcl_VarTraceInfo2) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, Tcl_VarTraceProc * procPtr, ClientData prevClientData)); /* 262 */ int (*tcl_Write) _ANSI_ARGS_((Tcl_Channel chan, CONST char * s, int slen)); /* 263 */ void (*tcl_WrongNumArgs) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], CONST char * message)); /* 264 */ int (*tcl_DumpActiveMemory) _ANSI_ARGS_((CONST char * fileName)); /* 265 */ void (*tcl_ValidateAllMemory) _ANSI_ARGS_((CONST char * file, int line)); /* 266 */ void (*tcl_AppendResultVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 267 */ void (*tcl_AppendStringsToObjVA) _ANSI_ARGS_((Tcl_Obj * objPtr, va_list argList)); /* 268 */ - CONST char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ - CONST char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, char * str, char ** termPtr)); /* 270 */ - CONST char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ - CONST char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ + CONST84_RETURN char * (*tcl_HashStats) _ANSI_ARGS_((Tcl_HashTable * tablePtr)); /* 269 */ + CONST84_RETURN char * (*tcl_ParseVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, CONST84 char ** termPtr)); /* 270 */ + CONST84_RETURN char * (*tcl_PkgPresent) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 271 */ + CONST84_RETURN char * (*tcl_PkgPresentEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 272 */ int (*tcl_PkgProvide) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version)); /* 273 */ - CONST char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */ + CONST84_RETURN char * (*tcl_PkgRequire) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact)); /* 274 */ void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */ int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */ Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */ @@ -1906,7 +1914,7 @@ typedef struct TclStubs { void (*tcl_CreateThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 288 */ void (*tcl_DeleteThreadExitHandler) _ANSI_ARGS_((Tcl_ExitProc * proc, ClientData clientData)); /* 289 */ void (*tcl_DiscardResult) _ANSI_ARGS_((Tcl_SavedResult * statePtr)); /* 290 */ - int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, char * script, int numBytes, int flags)); /* 291 */ + int (*tcl_EvalEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, int numBytes, int flags)); /* 291 */ int (*tcl_EvalObjv) _ANSI_ARGS_((Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[], int flags)); /* 292 */ int (*tcl_EvalObjEx) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, int flags)); /* 293 */ void (*tcl_ExitThread) _ANSI_ARGS_((int status)); /* 294 */ @@ -1917,11 +1925,11 @@ typedef struct TclStubs { void (*tcl_FreeEncoding) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) _ANSI_ARGS_((void)); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 301 */ - CONST char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */ + CONST84_RETURN char * (*tcl_GetEncodingName) _ANSI_ARGS_((Tcl_Encoding encoding)); /* 302 */ void (*tcl_GetEncodingNames) _ANSI_ARGS_((Tcl_Interp * interp)); /* 303 */ int (*tcl_GetIndexFromObjStruct) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CONST VOID * tablePtr, int offset, CONST char * msg, int flags, int * indexPtr)); /* 304 */ VOID * (*tcl_GetThreadData) _ANSI_ARGS_((Tcl_ThreadDataKey * keyPtr, int size)); /* 305 */ - Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags)); /* 306 */ + Tcl_Obj * (*tcl_GetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags)); /* 306 */ ClientData (*tcl_InitNotifier) _ANSI_ARGS_((void)); /* 307 */ void (*tcl_MutexLock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 308 */ void (*tcl_MutexUnlock) _ANSI_ARGS_((Tcl_Mutex * mutexPtr)); /* 309 */ @@ -1932,7 +1940,7 @@ typedef struct TclStubs { void (*tcl_RestoreResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 314 */ void (*tcl_SaveResult) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_SavedResult * statePtr)); /* 315 */ int (*tcl_SetSystemEncoding) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name)); /* 316 */ - Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */ + Tcl_Obj * (*tcl_SetVar2Ex) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, Tcl_Obj * newValuePtr, int flags)); /* 317 */ void (*tcl_ThreadAlert) _ANSI_ARGS_((Tcl_ThreadId threadId)); /* 318 */ void (*tcl_ThreadQueueEvent) _ANSI_ARGS_((Tcl_ThreadId threadId, Tcl_Event* evPtr, Tcl_QueuePosition position)); /* 319 */ Tcl_UniChar (*tcl_UniCharAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 320 */ @@ -1940,13 +1948,13 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToTitle) _ANSI_ARGS_((int ch)); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) _ANSI_ARGS_((int ch)); /* 323 */ int (*tcl_UniCharToUtf) _ANSI_ARGS_((int ch, char * buf)); /* 324 */ - CONST char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ + CONST84_RETURN char * (*tcl_UtfAtIndex) _ANSI_ARGS_((CONST char * src, int index)); /* 325 */ int (*tcl_UtfCharComplete) _ANSI_ARGS_((CONST char * src, int len)); /* 326 */ int (*tcl_UtfBackslash) _ANSI_ARGS_((CONST char * src, int * readPtr, char * dst)); /* 327 */ - CONST char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ - CONST char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ - CONST char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */ - CONST char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */ + CONST84_RETURN char * (*tcl_UtfFindFirst) _ANSI_ARGS_((CONST char * src, int ch)); /* 328 */ + CONST84_RETURN char * (*tcl_UtfFindLast) _ANSI_ARGS_((CONST char * src, int ch)); /* 329 */ + CONST84_RETURN char * (*tcl_UtfNext) _ANSI_ARGS_((CONST char * src)); /* 330 */ + CONST84_RETURN char * (*tcl_UtfPrev) _ANSI_ARGS_((CONST char * src, CONST char * start)); /* 331 */ int (*tcl_UtfToExternal) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Encoding encoding, CONST char * src, int srcLen, int flags, Tcl_EncodingState * statePtr, char * dst, int dstLen, int * srcReadPtr, int * dstWrotePtr, int * dstCharsPtr)); /* 332 */ char * (*tcl_UtfToExternalDString) _ANSI_ARGS_((Tcl_Encoding encoding, CONST char * src, int srcLen, Tcl_DString * dsPtr)); /* 333 */ int (*tcl_UtfToLower) _ANSI_ARGS_((char * src)); /* 334 */ @@ -1956,7 +1964,7 @@ typedef struct TclStubs { int (*tcl_WriteChars) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 338 */ int (*tcl_WriteObj) _ANSI_ARGS_((Tcl_Channel chan, Tcl_Obj * objPtr)); /* 339 */ char * (*tcl_GetString) _ANSI_ARGS_((Tcl_Obj * objPtr)); /* 340 */ - CONST char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */ + CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) _ANSI_ARGS_((void)); /* 341 */ void (*tcl_SetDefaultEncodingDir) _ANSI_ARGS_((CONST char * path)); /* 342 */ void (*tcl_AlertNotifier) _ANSI_ARGS_((ClientData clientData)); /* 343 */ void (*tcl_ServiceModeHook) _ANSI_ARGS_((int mode)); /* 344 */ @@ -1975,11 +1983,11 @@ typedef struct TclStubs { Tcl_Obj * (*tcl_EvalTokens) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Token * tokenPtr, int count)); /* 357 */ void (*tcl_FreeParse) _ANSI_ARGS_((Tcl_Parse * parsePtr)); /* 358 */ void (*tcl_LogCommandInfo) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * script, CONST char * command, int length)); /* 359 */ - int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 360 */ - int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ - int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ - int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append, char ** termPtr)); /* 363 */ - int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ + int (*tcl_ParseBraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 360 */ + int (*tcl_ParseCommand) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, int nested, Tcl_Parse * parsePtr)); /* 361 */ + int (*tcl_ParseExpr) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr)); /* 362 */ + int (*tcl_ParseQuotedString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append, CONST84 char ** termPtr)); /* 363 */ + int (*tcl_ParseVarName) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string, int numBytes, Tcl_Parse * parsePtr, int append)); /* 364 */ char * (*tcl_GetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 365 */ int (*tcl_Chdir) _ANSI_ARGS_((CONST char * dirName)); /* 366 */ int (*tcl_Access) _ANSI_ARGS_((CONST char * path, int mode)); /* 367 */ @@ -2013,7 +2021,7 @@ typedef struct TclStubs { int (*tcl_WriteRaw) _ANSI_ARGS_((Tcl_Channel chan, CONST char * src, int srcLen)); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) _ANSI_ARGS_((Tcl_Channel chan)); /* 396 */ int (*tcl_ChannelBuffered) _ANSI_ARGS_((Tcl_Channel chan)); /* 397 */ - CONST char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */ + CONST84_RETURN char * (*tcl_ChannelName) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) _ANSI_ARGS_((Tcl_ChannelType * chanTypePtr)); /* 401 */ diff --git a/generic/tclEnv.c b/generic/tclEnv.c index 0f71547..6e3b106 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.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: tclEnv.c,v 1.15 2002/06/06 17:37:55 das Exp $ + * RCS: @(#) $Id: tclEnv.c,v 1.16 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -46,8 +46,8 @@ char **environ = NULL; */ static char * EnvTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); static void ReplaceString _ANSI_ARGS_((CONST char *oldStr, char *newStr)); void TclSetEnv _ANSI_ARGS_((CONST char *name, @@ -520,7 +520,7 @@ EnvTraceProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter whose "env" variable is * being modified. */ - char *name1; /* Better be "env". */ + CONST char *name1; /* Better be "env". */ CONST char *name2; /* Name of variable being modified, or NULL * if whole array is being deleted (UTF-8). */ int flags; /* Indicates what's happening. */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 4f0ec61..27365a4 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.22 2002/05/14 09:44:43 vincentdarley Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.23 2002/08/05 03:24:40 dgp Exp $ */ #include "tclInt.h" @@ -111,8 +111,8 @@ static void BgErrorDeleteProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp)); static void HandleBgErrors _ANSI_ARGS_((ClientData clientData)); static char * VwaitVarProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); /* *---------------------------------------------------------------------- @@ -222,7 +222,7 @@ HandleBgErrors(clientData) ClientData clientData; /* Pointer to ErrAssocData structure. */ { Tcl_Interp *interp; - char *argv[2]; + CONST char *argv[2]; int code; BgError *errPtr; ErrAssocData *assocPtr = (ErrAssocData *) clientData; @@ -1012,7 +1012,7 @@ static char * VwaitVarProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Pointer to integer to set to 1. */ Tcl_Interp *interp; /* Interpreter containing variable. */ - char *name1; /* Name of variable. */ + CONST char *name1; /* Name of variable. */ CONST char *name2; /* Second part of variable name. */ int flags; /* Information about what happened. */ { diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 63d47ad..5a91a50 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.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: tclInt.decls,v 1.53 2002/07/17 18:21:54 msofer Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.54 2002/08/05 03:24:40 dgp Exp $ library tcl @@ -183,7 +183,7 @@ declare 42 generic { char * TclpGetUserHome(CONST char *name, Tcl_DString *bufferPtr) } declare 43 generic { - int TclGlobalInvoke(Tcl_Interp *interp, int argc, char **argv, int flags) + int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) } declare 44 generic { int TclGuessPackageName(CONST char *fileName, Tcl_DString *bufPtr) @@ -216,11 +216,11 @@ declare 51 generic { int TclInterpInit(Tcl_Interp *interp) } declare 52 generic { - int TclInvoke(Tcl_Interp *interp, int argc, char **argv, int flags) + int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, int flags) } declare 53 generic { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) + int argc, CONST84 char **argv) } declare 54 generic { int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, @@ -240,7 +240,7 @@ declare 55 generic { # int TclLooksLikeInt(char *p) # } declare 58 generic { - Var * TclLookupVar(Tcl_Interp *interp, char *part1, CONST char *part2, + Var * TclLookupVar(Tcl_Interp *interp, CONST char *part1, CONST char *part2, int flags, CONST char *msg, int createPart1, int createPart2, Var **arrayPtrPtr) } @@ -351,7 +351,7 @@ declare 81 generic { # } declare 88 generic { char * TclPrecTraceProc(ClientData clientData, Tcl_Interp *interp, - char *name1, CONST char *name2, int flags) + CONST char *name1, CONST char *name2, int flags) } declare 89 generic { int TclPreventAliasLoop(Tcl_Interp *interp, Tcl_Interp *cmdInterp, @@ -374,7 +374,7 @@ declare 93 generic { } declare 94 generic { int TclProcInterpProc(ClientData clientData, Tcl_Interp *interp, - int argc, char **argv) + int argc, CONST84 char **argv) } # Replaced by Tcl_FSStat in 8.4: #declare 95 generic { @@ -536,7 +536,7 @@ declare 135 generic { # int TclpChdir(CONST char *dirName) #} declare 138 generic { - CONST char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) + CONST84_RETURN char * TclGetEnv(CONST char *name, Tcl_DString *valuePtr) } #declare 139 generic { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, @@ -548,7 +548,7 @@ declare 140 generic { } # This is used by TclX, but should otherwise be considered private declare 141 generic { - CONST char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) + CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 generic { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -614,13 +614,13 @@ declare 156 generic { int status) } declare 157 generic { - Var * TclVarTraceExists (Tcl_Interp *interp, char *varName) + Var * TclVarTraceExists (Tcl_Interp *interp, CONST char *varName) } declare 158 generic { void TclSetStartupScriptFileName(CONST char *filename) } declare 159 generic { - CONST char *TclGetStartupScriptFileName(void) + CONST84_RETURN char *TclGetStartupScriptFileName(void) } #declare 160 generic { # int TclpMatchFilesTypes(Tcl_Interp *interp, char *separators, @@ -676,12 +676,12 @@ declare 169 generic { int TclpUtfNcmp2(CONST char *s1, CONST char *s2, unsigned long n) } declare 170 generic { - int TclCheckInterpTraces (Tcl_Interp *interp, char *command, int numChars, \ + int TclCheckInterpTraces (Tcl_Interp *interp, CONST char *command, int numChars, \ Command *cmdPtr, int result, int traceFlags, int objc, \ Tcl_Obj *CONST objv[]) } declare 171 generic { - int TclCheckExecutionTraces (Tcl_Interp *interp, char *command, int numChars, \ + int TclCheckExecutionTraces (Tcl_Interp *interp, CONST char *command, int numChars, \ Command *cmdPtr, int result, int traceFlags, int objc, \ Tcl_Obj *CONST objv[]) } diff --git a/generic/tclInt.h b/generic/tclInt.h index 9632bdd..9193564 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.109 2002/07/31 14:57:09 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.110 2002/08/05 03:24:41 dgp Exp $ */ #ifndef _TCLINT @@ -1594,10 +1594,8 @@ typedef Tcl_Channel (TclOpenFileChannelProc_) _ANSI_ARGS_((Tcl_Interp *interp, *---------------------------------------------------------------- */ -typedef int (*TclCmdProcType) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char *argv[])); -typedef int (*TclObjCmdProcType) _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, struct Tcl_Obj * CONST objv[])); +typedef Tcl_CmdProc *TclCmdProcType; +typedef Tcl_ObjCmdProc *TclObjCmdProcType; /* *---------------------------------------------------------------- @@ -1738,6 +1736,14 @@ EXTERN Tcl_Obj * TclLsetFlat _ANSI_ARGS_((Tcl_Interp* interp, Tcl_Obj *CONST indexArray[], Tcl_Obj* valuePtr )); +EXTERN int TclParseBackslash _ANSI_ARGS_((CONST char *src, + int numBytes, int *readPtr, char *dst)); +EXTERN int TclParseHex _ANSI_ARGS_((CONST char *src, int numBytes, + Tcl_UniChar *resultPtr)); +EXTERN int TclParseInteger _ANSI_ARGS_((CONST char *string, + int numBytes)); +EXTERN int TclParseWhiteSpace _ANSI_ARGS_((CONST char *src, + int numBytes, Tcl_Parse *parsePtr, char *typePtr)); EXTERN int TclpObjAccess _ANSI_ARGS_((Tcl_Obj *filename, int mode)); EXTERN int TclpObjLstat _ANSI_ARGS_((Tcl_Obj *pathPtr, @@ -2007,7 +2013,7 @@ EXTERN int Tcl_WhileObjCmd _ANSI_ARGS_((ClientData clientData, #ifdef MAC_TCL EXTERN int Tcl_EchoCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST84 char **argv)); EXTERN int Tcl_LsObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); EXTERN int Tcl_BeepObjCmd _ANSI_ARGS_((ClientData clientData, @@ -2078,13 +2084,13 @@ EXTERN Var * TclObjLookupVar _ANSI_ARGS_((Tcl_Interp *interp, CONST char *msg, CONST int createPart1, CONST int createPart2, Var **arrayPtrPtr)); EXTERN Tcl_Obj *TclPtrGetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, - Var *arrayPtr, char *part1, CONST char *part2, + Var *arrayPtr, CONST char *part1, CONST char *part2, CONST int flags)); EXTERN Tcl_Obj *TclPtrSetVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, - Var *arrayPtr, char *part1, CONST char *part2, + Var *arrayPtr, CONST char *part1, CONST char *part2, Tcl_Obj *newValuePtr, CONST int flags)); EXTERN Tcl_Obj *TclPtrIncrVar _ANSI_ARGS_((Tcl_Interp *interp, Var *varPtr, - Var *arrayPtr, char *part1, CONST char *part2, + Var *arrayPtr, CONST char *part1, CONST char *part2, CONST long i, CONST int flags)); /* diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 5d7f063..4309c93 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIntDecls.h,v 1.44 2002/07/17 18:21:54 msofer Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.45 2002/08/05 03:24:41 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -160,7 +160,7 @@ EXTERN char * TclpGetUserHome _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 43 */ EXTERN int TclGlobalInvoke _ANSI_ARGS_((Tcl_Interp * interp, - int argc, char ** argv, int flags)); + int argc, CONST84 char ** argv, int flags)); /* 44 */ EXTERN int TclGuessPackageName _ANSI_ARGS_(( CONST char * fileName, Tcl_DString * bufPtr)); @@ -183,11 +183,11 @@ EXTERN void TclInitCompiledLocals _ANSI_ARGS_(( EXTERN int TclInterpInit _ANSI_ARGS_((Tcl_Interp * interp)); /* 52 */ EXTERN int TclInvoke _ANSI_ARGS_((Tcl_Interp * interp, int argc, - char ** argv, int flags)); + CONST84 char ** argv, int flags)); /* 53 */ EXTERN int TclInvokeObjectCommand _ANSI_ARGS_(( ClientData clientData, Tcl_Interp * interp, - int argc, char ** argv)); + int argc, CONST84 char ** argv)); /* 54 */ EXTERN int TclInvokeStringCommand _ANSI_ARGS_(( ClientData clientData, Tcl_Interp * interp, @@ -198,8 +198,8 @@ EXTERN Proc * TclIsProc _ANSI_ARGS_((Command * cmdPtr)); /* Slot 57 is reserved */ /* 58 */ EXTERN Var * TclLookupVar _ANSI_ARGS_((Tcl_Interp * interp, - char * part1, CONST char * part2, int flags, - CONST char * msg, int createPart1, + CONST char * part1, CONST char * part2, + int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* Slot 59 is reserved */ /* 60 */ @@ -255,7 +255,7 @@ EXTERN char * TclpRealloc _ANSI_ARGS_((char * ptr, /* Slot 87 is reserved */ /* 88 */ EXTERN char * TclPrecTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp * interp, char * name1, + Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)); /* 89 */ EXTERN int TclPreventAliasLoop _ANSI_ARGS_((Tcl_Interp * interp, @@ -272,7 +272,8 @@ EXTERN int TclProcCompileProc _ANSI_ARGS_((Tcl_Interp * interp, EXTERN void TclProcDeleteProc _ANSI_ARGS_((ClientData clientData)); /* 94 */ EXTERN int TclProcInterpProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp * interp, int argc, char ** argv)); + Tcl_Interp * interp, int argc, + CONST84 char ** argv)); /* Slot 95 is reserved */ /* 96 */ EXTERN int TclRenameCommand _ANSI_ARGS_((Tcl_Interp * interp, @@ -410,14 +411,14 @@ EXTERN int TclpCheckStackSpace _ANSI_ARGS_((void)); /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ -EXTERN CONST char * TclGetEnv _ANSI_ARGS_((CONST char * name, +EXTERN CONST84_RETURN char * TclGetEnv _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* Slot 139 is reserved */ /* 140 */ EXTERN int TclLooksLikeInt _ANSI_ARGS_((CONST char * bytes, int length)); /* 141 */ -EXTERN CONST char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, +EXTERN CONST84_RETURN char * TclpGetCwd _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 142 */ EXTERN int TclSetByteCodeFromAny _ANSI_ARGS_(( @@ -458,12 +459,12 @@ EXTERN void TclRegError _ANSI_ARGS_((Tcl_Interp * interp, CONST char * msg, int status)); /* 157 */ EXTERN Var * TclVarTraceExists _ANSI_ARGS_((Tcl_Interp * interp, - char * varName)); + CONST char * varName)); /* 158 */ EXTERN void TclSetStartupScriptFileName _ANSI_ARGS_(( CONST char * filename)); /* 159 */ -EXTERN CONST char * TclGetStartupScriptFileName _ANSI_ARGS_((void)); +EXTERN CONST84_RETURN char * TclGetStartupScriptFileName _ANSI_ARGS_((void)); /* Slot 160 is reserved */ /* 161 */ EXTERN int TclChannelTransform _ANSI_ARGS_((Tcl_Interp * interp, @@ -491,13 +492,13 @@ EXTERN int TclpUtfNcmp2 _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 170 */ EXTERN int TclCheckInterpTraces _ANSI_ARGS_(( - Tcl_Interp * interp, char * command, + Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ EXTERN int TclCheckExecutionTraces _ANSI_ARGS_(( - Tcl_Interp * interp, char * command, + Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); @@ -565,7 +566,7 @@ typedef struct TclIntStubs { int (*tclGetOpenMode) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, int * seekFlagPtr)); /* 40 */ Tcl_Command (*tclGetOriginalCommand) _ANSI_ARGS_((Tcl_Command command)); /* 41 */ char * (*tclpGetUserHome) _ANSI_ARGS_((CONST char * name, Tcl_DString * bufferPtr)); /* 42 */ - int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 43 */ + int (*tclGlobalInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 43 */ int (*tclGuessPackageName) _ANSI_ARGS_((CONST char * fileName, Tcl_DString * bufPtr)); /* 44 */ int (*tclHideUnsafeCommands) _ANSI_ARGS_((Tcl_Interp * interp)); /* 45 */ int (*tclInExit) _ANSI_ARGS_((void)); /* 46 */ @@ -574,13 +575,13 @@ typedef struct TclIntStubs { Tcl_Obj * (*tclIncrVar2) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * part1Ptr, Tcl_Obj * part2Ptr, long incrAmount, int part1NotParsed)); /* 49 */ void (*tclInitCompiledLocals) _ANSI_ARGS_((Tcl_Interp * interp, CallFrame * framePtr, Namespace * nsPtr)); /* 50 */ int (*tclInterpInit) _ANSI_ARGS_((Tcl_Interp * interp)); /* 51 */ - int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, char ** argv, int flags)); /* 52 */ - int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 53 */ + int (*tclInvoke) _ANSI_ARGS_((Tcl_Interp * interp, int argc, CONST84 char ** argv, int flags)); /* 52 */ + int (*tclInvokeObjectCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 53 */ int (*tclInvokeStringCommand) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *CONST objv[])); /* 54 */ Proc * (*tclIsProc) _ANSI_ARGS_((Command * cmdPtr)); /* 55 */ void *reserved56; void *reserved57; - Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */ + Var * (*tclLookupVar) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * part1, CONST char * part2, int flags, CONST char * msg, int createPart1, int createPart2, Var ** arrayPtrPtr)); /* 58 */ void *reserved59; int (*tclNeedSpace) _ANSI_ARGS_((CONST char * start, CONST char * end)); /* 60 */ Tcl_Obj * (*tclNewProcBodyObj) _ANSI_ARGS_((Proc * procPtr)); /* 61 */ @@ -610,13 +611,13 @@ typedef struct TclIntStubs { void *reserved85; void *reserved86; void *reserved87; - char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, char * name1, CONST char * name2, int flags)); /* 88 */ + char * (*tclPrecTraceProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, CONST char * name1, CONST char * name2, int flags)); /* 88 */ int (*tclPreventAliasLoop) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Interp * cmdInterp, Tcl_Command cmd)); /* 89 */ void *reserved90; void (*tclProcCleanupProc) _ANSI_ARGS_((Proc * procPtr)); /* 91 */ int (*tclProcCompileProc) _ANSI_ARGS_((Tcl_Interp * interp, Proc * procPtr, Tcl_Obj * bodyPtr, Namespace * nsPtr, CONST char * description, CONST char * procName)); /* 92 */ void (*tclProcDeleteProc) _ANSI_ARGS_((ClientData clientData)); /* 93 */ - int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, char ** argv)); /* 94 */ + int (*tclProcInterpProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp * interp, int argc, CONST84 char ** argv)); /* 94 */ void *reserved95; int (*tclRenameCommand) _ANSI_ARGS_((Tcl_Interp * interp, char * oldName, char * newName)); /* 96 */ void (*tclResetShadowedCmdRefs) _ANSI_ARGS_((Tcl_Interp * interp, Command * newCmdPtr)); /* 97 */ @@ -676,10 +677,10 @@ typedef struct TclIntStubs { int (*tclpCheckStackSpace) _ANSI_ARGS_((void)); /* 135 */ void *reserved136; void *reserved137; - CONST char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ + CONST84_RETURN char * (*tclGetEnv) _ANSI_ARGS_((CONST char * name, Tcl_DString * valuePtr)); /* 138 */ void *reserved139; int (*tclLooksLikeInt) _ANSI_ARGS_((CONST char * bytes, int length)); /* 140 */ - CONST char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ + CONST84_RETURN char * (*tclpGetCwd) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_DString * cwdPtr)); /* 141 */ int (*tclSetByteCodeFromAny) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, CompileHookProc * hookProc, ClientData clientData)); /* 142 */ int (*tclAddLiteralObj) _ANSI_ARGS_((struct CompileEnv * envPtr, Tcl_Obj * objPtr, LiteralEntry ** litPtrPtr)); /* 143 */ void (*tclHideLiteral) _ANSI_ARGS_((Tcl_Interp * interp, struct CompileEnv * envPtr, int index)); /* 144 */ @@ -695,9 +696,9 @@ typedef struct TclIntStubs { void *reserved154; void *reserved155; void (*tclRegError) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * msg, int status)); /* 156 */ - Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, char * varName)); /* 157 */ + Var * (*tclVarTraceExists) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * varName)); /* 157 */ void (*tclSetStartupScriptFileName) _ANSI_ARGS_((CONST char * filename)); /* 158 */ - CONST char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */ + CONST84_RETURN char * (*tclGetStartupScriptFileName) _ANSI_ARGS_((void)); /* 159 */ void *reserved160; int (*tclChannelTransform) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Channel chan, Tcl_Obj * cmdObjPtr)); /* 161 */ void (*tclChannelEventScriptInvoker) _ANSI_ARGS_((ClientData clientData, int flags)); /* 162 */ @@ -708,8 +709,8 @@ typedef struct TclIntStubs { void (*tclSetStartupScriptPath) _ANSI_ARGS_((Tcl_Obj * pathPtr)); /* 167 */ Tcl_Obj * (*tclGetStartupScriptPath) _ANSI_ARGS_((void)); /* 168 */ int (*tclpUtfNcmp2) _ANSI_ARGS_((CONST char * s1, CONST char * s2, unsigned long n)); /* 169 */ - int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */ - int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ + int (*tclCheckInterpTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 170 */ + int (*tclCheckExecutionTraces) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * command, int numChars, Command * cmdPtr, int result, int traceFlags, int objc, Tcl_Obj *CONST objv[])); /* 171 */ } TclIntStubs; #ifdef __cplusplus diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 77becd1..383bae3 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.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: tclInterp.c,v 1.15 2002/07/31 12:34:23 msofer Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.16 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -835,7 +835,7 @@ Tcl_CreateAlias(slaveInterp, slaveCmd, targetInterp, targetCmd, argc, argv) Tcl_Interp *targetInterp; /* Interpreter for target command. */ CONST char *targetCmd; /* Name of target command. */ int argc; /* How many additional arguments? */ - char * CONST *argv; /* These are the additional args. */ + CONST char * CONST *argv; /* These are the additional args. */ { Tcl_Obj *slaveObjPtr, *targetObjPtr; Tcl_Obj **objv; @@ -933,7 +933,7 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr, Tcl_Interp **targetInterpPtr; /* (Return) target interpreter. */ CONST char **targetNamePtr; /* (Return) name of target command. */ int *argcPtr; /* (Return) count of addnl args. */ - char ***argvPtr; /* (Return) additional arguments. */ + CONST char ***argvPtr; /* (Return) additional arguments. */ { InterpInfo *iiPtr; Tcl_HashEntry *hPtr; @@ -962,7 +962,8 @@ Tcl_GetAlias(interp, aliasName, targetInterpPtr, targetNamePtr, argcPtr, *argcPtr = objc - 1; } if (argvPtr != NULL) { - *argvPtr = (char **) ckalloc((unsigned) sizeof(char *) * (objc - 1)); + *argvPtr = (CONST char **) + ckalloc((unsigned) sizeof(CONST char *) * (objc - 1)); for (i = 1; i < objc; i++) { *argvPtr[i - 1] = Tcl_GetString(objv[i]); } diff --git a/generic/tclLink.c b/generic/tclLink.c index b81554e..3476766 100644 --- a/generic/tclLink.c +++ b/generic/tclLink.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: tclLink.c,v 1.7 2002/03/20 22:47:36 dgp Exp $ + * RCS: @(#) $Id: tclLink.c,v 1.8 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -60,8 +60,8 @@ typedef struct Link { */ static char * LinkTraceProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, char *name1, CONST char *name2, - int flags)); + Tcl_Interp *interp, CONST char *name1, + CONST char *name2, int flags)); static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr)); /* @@ -88,7 +88,7 @@ static Tcl_Obj * ObjValue _ANSI_ARGS_((Link *linkPtr)); int Tcl_LinkVar(interp, varName, addr, type) Tcl_Interp *interp; /* Interpreter in which varName exists. */ - char *varName; /* Name of a global variable in interp. */ + CONST char *varName; /* Name of a global variable in interp. */ char *addr; /* Address of a C variable to be linked * to varName. */ int type; /* Type of C variable: TCL_LINK_INT, etc. @@ -149,7 +149,7 @@ Tcl_LinkVar(interp, varName, addr, type) void Tcl_UnlinkVar(interp, varName) Tcl_Interp *interp; /* Interpreter containing variable to unlink. */ - char *varName; /* Global variable in interp to unlink. */ + CONST char *varName; /* Global variable in interp to unlink. */ { Link *linkPtr; @@ -187,7 +187,7 @@ Tcl_UnlinkVar(interp, varName) void Tcl_UpdateLinkedVar(interp, varName) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *varName; /* Name of global variable that is linked. */ + CONST char *varName; /* Name of global variable that is linked. */ { Link *linkPtr; int savedFlag; @@ -229,7 +229,7 @@ static char * LinkTraceProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Contains information about the link. */ Tcl_Interp *interp; /* Interpreter containing Tcl variable. */ - char *name1; /* First part of variable name. */ + CONST char *name1; /* First part of variable name. */ CONST char *name2; /* Second part of variable name. */ int flags; /* Miscellaneous additional information. */ { diff --git a/generic/tclObj.c b/generic/tclObj.c index 926fa9f..78581f2 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclObj.c,v 1.34 2002/07/29 15:56:54 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.35 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -1209,7 +1209,7 @@ SetBooleanFromAny(interp, objPtr) * Still might be a string containing the characters representing an * int or double that wasn't handled above. This would be a string * like "27" or "1.0" that is non-zero and not "1". Such a string - * whould result in the boolean value true. We try converting to + * would result in the boolean value true. We try converting to * double. If that succeeds and the resulting double is non-zero, we * have a "true". Note that numbers can't have embedded NULLs. */ diff --git a/generic/tclParse.c b/generic/tclParse.c index b22df23..230edee 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -8,11 +8,12 @@ * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 Ajuba Solutions. + * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParse.c,v 1.21 2002/07/19 10:12:28 dkf Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.22 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -31,32 +32,32 @@ * information about its character argument. The following return * values are defined. * - * TYPE_NORMAL - All characters that don't have special significance - * to the Tcl parser. - * TYPE_SPACE - The character is a whitespace character other - * than newline. - * TYPE_COMMAND_END - Character is newline or semicolon. - * TYPE_SUBS - Character begins a substitution or has other - * special meaning in ParseTokens: backslash, dollar - * sign, open bracket, or null. - * TYPE_QUOTE - Character is a double quote. - * TYPE_CLOSE_PAREN - Character is a right parenthesis. - * TYPE_CLOSE_BRACK - Character is a right square bracket. - * TYPE_BRACE - Character is a curly brace (either left or right). + * TYPE_NORMAL - All characters that don't have special significance + * to the Tcl parser. + * TYPE_SPACE - The character is a whitespace character other + * than newline. + * TYPE_COMMAND_END - Character is newline or semicolon. + * TYPE_SUBS - Character begins a substitution or has other + * special meaning in ParseTokens: backslash, dollar + * sign, or open bracket. + * TYPE_QUOTE - Character is a double quote. + * TYPE_CLOSE_PAREN - Character is a right parenthesis. + * TYPE_CLOSE_BRACK - Character is a right square bracket. + * TYPE_BRACE - Character is a curly brace (either left or right). */ -#define TYPE_NORMAL 0 -#define TYPE_SPACE 0x1 -#define TYPE_COMMAND_END 0x2 -#define TYPE_SUBS 0x4 -#define TYPE_QUOTE 0x8 -#define TYPE_CLOSE_PAREN 0x10 -#define TYPE_CLOSE_BRACK 0x20 -#define TYPE_BRACE 0x40 +#define TYPE_NORMAL 0 +#define TYPE_SPACE 0x1 +#define TYPE_COMMAND_END 0x2 +#define TYPE_SUBS 0x4 +#define TYPE_QUOTE 0x8 +#define TYPE_CLOSE_PAREN 0x10 +#define TYPE_CLOSE_BRACK 0x20 +#define TYPE_BRACE 0x40 -#define CHAR_TYPE(c) (typeTable+128)[(int)(c)] +#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)] -static CONST char typeTable[] = { +static CONST char charTypeTable[] = { /* * Negative character values, from -128 to -1: */ @@ -173,11 +174,13 @@ static CONST char typeTable[] = { * Prototypes for local procedures defined in this file: */ -static int CommandComplete _ANSI_ARGS_((char *script, - int length)); -static int ParseTokens _ANSI_ARGS_((char *src, int mask, +static int CommandComplete _ANSI_ARGS_((CONST char *script, + int numBytes)); +static int ParseComment _ANSI_ARGS_((CONST char *src, int numBytes, Tcl_Parse *parsePtr)); - +static int ParseTokens _ANSI_ARGS_((CONST char *src, int numBytes, + int mask, Tcl_Parse *parsePtr)); + /* *---------------------------------------------------------------------- * @@ -209,14 +212,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* First character of string containing - * one or more Tcl commands. The string - * must be in writable memory and must - * have one additional byte of space at - * string[length] where we can - * temporarily store a 0 sentinel - * character. */ - int numBytes; /* Total number of bytes in string. If < 0, + CONST char *string; /* First character of string containing + * one or more Tcl commands. */ + register int numBytes; /* Total number of bytes in string. If < 0, * the script consists of all bytes up to * the first null character. */ int nested; /* Non-zero means this is a nested command: @@ -229,21 +227,25 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * information in the structure is * ignored. */ { - register char *src; /* Points to current character + register CONST char *src; /* Points to current character * in the command. */ - int type; /* Result returned by CHAR_TYPE(*src). */ + char type; /* Result returned by CHAR_TYPE(*src). */ Tcl_Token *tokenPtr; /* Pointer to token being filled in. */ int wordIndex; /* Index of word token for current word. */ - char utfBytes[TCL_UTF_MAX]; /* Holds result of backslash substitution. */ int terminators; /* CHAR_TYPE bits that indicate the end * of a command. */ - char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to + CONST char *termPtr; /* Set by Tcl_ParseBraces/QuotedString to * point to char after terminating one. */ - int length, savedChar; - - + int scanned; + + if ((string == NULL) && (numBytes>0)) { + if (interp != NULL) { + Tcl_SetResult(interp, "can't parse a NULL pointer", TCL_STATIC); + } + return TCL_ERROR; + } if (numBytes < 0) { - numBytes = (string? strlen(string) : 0); + numBytes = strlen(string); } parsePtr->commentStart = NULL; parsePtr->commentSize = 0; @@ -266,66 +268,15 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) } /* - * Temporarily overwrite the character just after the end of the - * string with a 0 byte. This acts as a sentinel and reduces the - * number of places where we have to check for the end of the - * input string. The original value of the byte is restored at - * the end of the parse. - */ - - savedChar = string[numBytes]; - if (savedChar != 0) { - string[numBytes] = 0; - } - - /* * Parse any leading space and comments before the first word of the * command. */ - src = string; - while (1) { - while ((CHAR_TYPE(*src) == TYPE_SPACE) || (*src == '\n')) { - src++; - } - if ((*src == '\\') && (src[1] == '\n')) { - /* - * Skip backslash-newline sequence: it should be treated - * just like white space. - */ - - if ((src + 2) == parsePtr->end) { - parsePtr->incomplete = 1; - } - src += 2; - continue; - } - if (*src != '#') { - break; - } - if (parsePtr->commentStart == NULL) { - parsePtr->commentStart = src; - } - while (1) { - if (src == parsePtr->end) { - if (nested) { - parsePtr->incomplete = nested; - } - parsePtr->commentSize = src - parsePtr->commentStart; - break; - } else if (*src == '\\') { - if ((src[1] == '\n') && ((src + 2) == parsePtr->end)) { - parsePtr->incomplete = 1; - } - Tcl_UtfBackslash(src, &length, utfBytes); - src += length; - } else if (*src == '\n') { - src++; - parsePtr->commentSize = src - parsePtr->commentStart; - break; - } else { - src++; - } + scanned = ParseComment(string, numBytes, parsePtr); + src = (string + scanned); numBytes -= scanned; + if (numBytes == 0) { + if (nested) { + parsePtr->incomplete = nested; } } @@ -352,19 +303,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * sequence: it should be treated just like white space. */ - while (1) { - type = CHAR_TYPE(*src); - if (type == TYPE_SPACE) { - src++; - continue; - } else if ((*src == '\\') && (src[1] == '\n')) { - if ((src + 2) == parsePtr->end) { - parsePtr->incomplete = 1; - } - Tcl_UtfBackslash(src, &length, utfBytes); - src += length; - continue; - } + scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); + src += scanned; numBytes -= scanned; + if (numBytes == 0) { break; } if ((type & terminators) != 0) { @@ -372,9 +313,6 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) src++; break; } - if (src == parsePtr->end) { - break; - } tokenPtr->start = src; parsePtr->numTokens++; parsePtr->numWords++; @@ -386,28 +324,28 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) */ if (*src == '"') { - if (Tcl_ParseQuotedString(interp, src, (parsePtr->end - src), - parsePtr, 1, &termPtr) != TCL_OK) { + if (Tcl_ParseQuotedString(interp, src, numBytes, + parsePtr, 1, &termPtr) != TCL_OK) { goto error; } - src = termPtr; + src = termPtr; numBytes = parsePtr->end - src; } else if (*src == '{') { - if (Tcl_ParseBraces(interp, src, (parsePtr->end - src), - parsePtr, 1, &termPtr) != TCL_OK) { + if (Tcl_ParseBraces(interp, src, numBytes, + parsePtr, 1, &termPtr) != TCL_OK) { goto error; } - src = termPtr; + src = termPtr; numBytes = parsePtr->end - src; } else { /* * This is an unquoted word. Call ParseTokens and let it do * all of the work. */ - if (ParseTokens(src, TYPE_SPACE|terminators, + if (ParseTokens(src, numBytes, TYPE_SPACE|terminators, parsePtr) != TCL_OK) { goto error; } - src = parsePtr->term; + src = parsePtr->term; numBytes = parsePtr->end - src; } /* @@ -431,32 +369,18 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) * command. */ - type = CHAR_TYPE(*src); - if (type == TYPE_SPACE) { - src++; + scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); + if (scanned) { + src += scanned; numBytes -= scanned; continue; - } else { - /* - * Backslash-newline (and any following white space) must be - * treated as if it were a space character. - */ - - if ((*src == '\\') && (src[1] == '\n')) { - if ((src + 2) == parsePtr->end) { - parsePtr->incomplete = 1; - } - Tcl_UtfBackslash(src, &length, utfBytes); - src += length; - continue; - } } - if ((type & terminators) != 0) { - parsePtr->term = src; - src++; + if (numBytes == 0) { break; } - if (src == parsePtr->end) { + if ((type & terminators) != 0) { + parsePtr->term = src; + src++; break; } if (src[-1] == '"') { @@ -476,17 +400,10 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) goto error; } - parsePtr->commandSize = src - parsePtr->commandStart; - if (savedChar != 0) { - string[numBytes] = (char) savedChar; - } return TCL_OK; error: - if (savedChar != 0) { - string[numBytes] = (char) savedChar; - } Tcl_FreeParse(parsePtr); if (parsePtr->commandStart == NULL) { parsePtr->commandStart = string; @@ -494,17 +411,361 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) parsePtr->commandSize = parsePtr->term - parsePtr->commandStart; return TCL_ERROR; } + +/* + *---------------------------------------------------------------------- + * + * TclParseWhiteSpace -- + * + * Scans up to numBytes bytes starting at src, consuming white + * space as defined by Tcl's parsing rules. + * + * Results: + * Returns the number of bytes recognized as white space. Records + * at parsePtr, information about the parse. Records at typePtr + * the character type of the non-whitespace character that terminated + * the scan. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclParseWhiteSpace(src, numBytes, parsePtr, typePtr) + CONST char *src; /* First character to parse. */ + register int numBytes; /* Max number of bytes to scan. */ + Tcl_Parse *parsePtr; /* Information about parse in progress. + * Updated if parsing indicates + * an incomplete command. */ + char *typePtr; /* Points to location to store character + * type of character that ends run + * of whitespace */ +{ + register char type = TYPE_NORMAL; + register CONST char *p = src; + + while (1) { + while (numBytes && ((type = CHAR_TYPE(*p)) & TYPE_SPACE)) { + numBytes--; p++; + } + if (numBytes && (type & TYPE_SUBS)) { + if (*p != '\\') { + break; + } + if (--numBytes == 0) { + break; + } + if (p[1] != '\n') { + break; + } + p+=2; + if (--numBytes == 0) { + parsePtr->incomplete = 1; + break; + } + continue; + } + break; + } + *typePtr = type; + return (p - src); +} /* *---------------------------------------------------------------------- * + * TclParseHex -- + * + * Scans a hexadecimal number as a Tcl_UniChar value. + * (e.g., for parsing \x and \u escape sequences). + * At most numBytes bytes are scanned. + * + * Results: + * The numeric value is stored in *resultPtr. + * Returns the number of bytes consumed. + * + * Notes: + * Relies on the following properties of the ASCII + * character set, with which UTF-8 is compatible: + * + * The digits '0' .. '9' and the letters 'A' .. 'Z' and 'a' .. 'z' + * occupy consecutive code points, and '0' < 'A' < 'a'. + * + *---------------------------------------------------------------------- + */ +int +TclParseHex(src, numBytes, resultPtr) + CONST char *src; /* First character to parse. */ + int numBytes; /* Max number of byes to scan */ + Tcl_UniChar *resultPtr; /* Points to storage provided by + * caller where the Tcl_UniChar + * resulting from the conversion is + * to be written. */ +{ + Tcl_UniChar result = 0; + register CONST char *p = src; + + while (numBytes--) { + unsigned char digit = UCHAR(*p); + + if (!isxdigit(digit)) + break; + + ++p; + result <<= 4; + + if (digit >= 'a') { + result |= (10 + digit - 'a'); + } else if (digit >= 'A') { + result |= (10 + digit - 'A'); + } else { + result |= (digit - '0'); + } + } + + *resultPtr = result; + return (p - src); +} + +/* + *---------------------------------------------------------------------- + * + * TclParseBackslash -- + * + * Scans up to numBytes bytes starting at src, consuming a + * backslash sequence as defined by Tcl's parsing rules. + * + * Results: + * Records at readPtr the number of bytes making up the backslash + * sequence. Records at dst the UTF-8 encoded equivalent of + * that backslash sequence. Returns the number of bytes written + * to dst, at most TCL_UTF_MAX. Either readPtr or dst may be + * NULL, if the results are not needed, but the return value is + * the same either way. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +int +TclParseBackslash(src, numBytes, readPtr, dst) + CONST char * src; /* Points to the backslash character of a + * a backslash sequence */ + int numBytes; /* Max number of bytes to scan */ + int *readPtr; /* NULL, or points to storage where the + * number of bytes scanned should be written. */ + char *dst; /* NULL, or points to buffer where the UTF-8 + * encoding of the backslash sequence is to be + * written. At most TCL_UTF_MAX bytes will be + * written there. */ +{ + register CONST char *p = src+1; + Tcl_UniChar result; + int count; + char buf[TCL_UTF_MAX]; + + if (numBytes == 0) { + if (readPtr != NULL) { + *readPtr = 0; + } + return 0; + } + + if (dst == NULL) { + dst = buf; + } + + if (numBytes == 1) { + /* Can only scan the backslash. Return it. */ + result = '\\'; + count = 1; + goto done; + } + + count = 2; + switch (*p) { + /* + * Note: in the conversions below, use absolute values (e.g., + * 0xa) rather than symbolic values (e.g. \n) that get converted + * by the compiler. It's possible that compilers on some + * platforms will do the symbolic conversions differently, which + * could result in non-portable Tcl scripts. + */ + + case 'a': + result = 0x7; + break; + case 'b': + result = 0x8; + break; + case 'f': + result = 0xc; + break; + case 'n': + result = 0xa; + break; + case 'r': + result = 0xd; + break; + case 't': + result = 0x9; + break; + case 'v': + result = 0xb; + break; + case 'x': + count += TclParseHex(p+1, numBytes-1, &result); + if (count == 2) { + /* No hexadigits -> This is just "x". */ + result = 'x'; + } else { + /* Keep only the last byte (2 hex digits) */ + result = (unsigned char) result; + } + break; + case 'u': + count += TclParseHex(p+1, (numBytes > 5) ? 4 : numBytes-1, &result); + if (count == 2) { + /* No hexadigits -> This is just "u". */ + result = 'u'; + } + break; + case '\n': + count--; + do { + p++; count++; + } while ((count < numBytes) && ((*p == ' ') || (*p == '\t'))); + result = ' '; + break; + case 0: + result = '\\'; + count = 1; + break; + default: + /* + * Check for an octal number \oo?o? + */ + if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ + result = (unsigned char)(*p - '0'); + p++; + if ((numBytes == 2) || !isdigit(UCHAR(*p)) /* INTL: digit */ + || (UCHAR(*p) >= '8')) { + break; + } + count = 3; + result = (unsigned char)((result << 3) + (*p - '0')); + p++; + if ((numBytes == 3) || !isdigit(UCHAR(*p)) /* INTL: digit */ + || (UCHAR(*p) >= '8')) { + break; + } + count = 4; + result = (unsigned char)((result << 3) + (*p - '0')); + break; + } + /* + * We have to convert here in case the user has put a + * backslash in front of a multi-byte utf-8 character. + * While this means nothing special, we shouldn't break up + * a correct utf-8 character. [Bug #217987] test subst-3.2 + */ + if (Tcl_UtfCharComplete(p, numBytes - 1)) { + count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */ + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, p, (size_t) (numBytes - 1)); + utfBytes[numBytes - 1] = '\0'; + count = Tcl_UtfToUniChar(utfBytes, &result) + 1; + } + break; + } + + done: + if (readPtr != NULL) { + *readPtr = count; + } + return Tcl_UniCharToUtf((int) result, dst); +} + +/* + *---------------------------------------------------------------------- + * + * ParseComment -- + * + * Scans up to numBytes bytes starting at src, consuming a + * Tcl comment as defined by Tcl's parsing rules. + * + * Results: + * Records in parsePtr information about the parse. Returns the + * number of bytes consumed. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ +static int +ParseComment(src, numBytes, parsePtr) + CONST char *src; /* First character to parse. */ + register int numBytes; /* Max number of bytes to scan. */ + Tcl_Parse *parsePtr; /* Information about parse in progress. + * Updated if parsing indicates + * an incomplete command. */ +{ + register CONST char *p = src; + while (numBytes) { + char type; + int scanned; + do { + scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type); + p += scanned; numBytes -= scanned; + } while (numBytes && (*p == '\n') && (p++,numBytes--)); + if ((numBytes == 0) || (*p != '#')) { + break; + } + if (parsePtr->commentStart == NULL) { + parsePtr->commentStart = p; + } + while (numBytes) { + if (*p == '\\') { + scanned = TclParseWhiteSpace(p, numBytes, parsePtr, &type); + if (scanned) { + p += scanned; numBytes -= scanned; + } else { + /* + * General backslash substitution in comments isn't + * part of the formal spec, but test parse-15.47 + * and history indicate that it has been the de facto + * rule. Don't change it now. + */ + TclParseBackslash(p, numBytes, &scanned, NULL); + p += scanned; numBytes -= scanned; + } + } else { + p++; numBytes--; + if (p[-1] == '\n') { + break; + } + } + } + parsePtr->commentSize = p - parsePtr->commentStart; + } + return (p - src); +} + +/* + *---------------------------------------------------------------------- + * * ParseTokens -- * * This procedure forms the heart of the Tcl parser. It parses one * or more tokens from a string, up to a termination point * specified by the caller. This procedure is used to parse * unquoted command words (those not in quotes or braces), words in - * quotes, and array indices for variables. + * quotes, and array indices for variables. No more than numBytes + * bytes will be scanned. * * Results: * Tokens are added to parsePtr and parsePtr->term is filled in @@ -522,8 +783,9 @@ Tcl_ParseCommand(interp, string, numBytes, nested, parsePtr) */ static int -ParseTokens(src, mask, parsePtr) - register char *src; /* First character to parse. */ +ParseTokens(src, numBytes, mask, parsePtr) + register CONST char *src; /* First character to parse. */ + register int numBytes; /* Max number of bytes to scan. */ int mask; /* Specifies when to stop parsing. The * parse stops at the first unquoted * character whose CHAR_TYPE contains @@ -532,8 +794,8 @@ ParseTokens(src, mask, parsePtr) * Updated with additional tokens and * termination information. */ { - int type, originalTokens, varToken; - char utfBytes[TCL_UTF_MAX]; + char type; + int originalTokens, varToken; Tcl_Token *tokenPtr; Tcl_Parse nested; @@ -545,7 +807,7 @@ ParseTokens(src, mask, parsePtr) */ originalTokens = parsePtr->numTokens; - while (1) { + while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) { if (parsePtr->numTokens == parsePtr->tokensAvailable) { TclExpandTokenArray(parsePtr); } @@ -553,22 +815,15 @@ ParseTokens(src, mask, parsePtr) tokenPtr->start = src; tokenPtr->numComponents = 0; - type = CHAR_TYPE(*src); - if (type & mask) { - break; - } - if ((type & TYPE_SUBS) == 0) { /* * This is a simple range of characters. Scan to find the end * of the range. */ - while (1) { - src++; - if (CHAR_TYPE(*src) & (mask | TYPE_SUBS)) { - break; - } + while ((++src, --numBytes) + && !(CHAR_TYPE(*src) & (mask | TYPE_SUBS))) { + /* empty loop */ } tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = src - tokenPtr->start; @@ -580,11 +835,12 @@ ParseTokens(src, mask, parsePtr) */ varToken = parsePtr->numTokens; - if (Tcl_ParseVarName(parsePtr->interp, src, parsePtr->end - src, + if (Tcl_ParseVarName(parsePtr->interp, src, numBytes, parsePtr, 1) != TCL_OK) { return TCL_ERROR; } src += parsePtr->tokenPtr[varToken].size; + numBytes -= parsePtr->tokenPtr[varToken].size; } else if (*src == '[') { /* * Command substitution. Call Tcl_ParseCommand recursively @@ -592,23 +848,24 @@ ParseTokens(src, mask, parsePtr) * throw away the parse information. */ - src++; + src++; numBytes--; while (1) { if (Tcl_ParseCommand(parsePtr->interp, src, - parsePtr->end - src, 1, &nested) != TCL_OK) { + numBytes, 1, &nested) != TCL_OK) { parsePtr->errorType = nested.errorType; parsePtr->term = nested.term; parsePtr->incomplete = nested.incomplete; return TCL_ERROR; } src = nested.commandStart + nested.commandSize; + numBytes = parsePtr->end - src; if (nested.tokenPtr != nested.staticTokens) { ckfree((char *) nested.tokenPtr); } if ((*nested.term == ']') && !nested.incomplete) { break; } - if (src == parsePtr->end) { + if (numBytes == 0) { if (parsePtr->interp != NULL) { Tcl_SetResult(parsePtr->interp, "missing close-bracket", TCL_STATIC); @@ -626,9 +883,18 @@ ParseTokens(src, mask, parsePtr) /* * Backslash substitution. */ + TclParseBackslash(src, numBytes, &tokenPtr->size, NULL); + + if (tokenPtr->size == 1) { + /* Just a backslash, due to end of string */ + tokenPtr->type = TCL_TOKEN_TEXT; + parsePtr->numTokens++; + src++; numBytes--; + continue; + } if (src[1] == '\n') { - if ((src + 2) == parsePtr->end) { + if (numBytes == 2) { parsePtr->incomplete = 1; } @@ -639,28 +905,22 @@ ParseTokens(src, mask, parsePtr) */ if (mask & TYPE_SPACE) { + if (parsePtr->numTokens == originalTokens) { + goto finishToken; + } break; } } + tokenPtr->type = TCL_TOKEN_BS; - Tcl_UtfBackslash(src, &tokenPtr->size, utfBytes); parsePtr->numTokens++; src += tokenPtr->size; + numBytes -= tokenPtr->size; } else if (*src == 0) { - /* - * We encountered a null character. If it is the null - * character at the end of the string, then return. - * Otherwise generate a text token for the single - * character. - */ - - if (src == parsePtr->end) { - break; - } tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; parsePtr->numTokens++; - src++; + src++; numBytes--; } else { panic("ParseTokens encountered unknown character"); } @@ -671,7 +931,14 @@ ParseTokens(src, mask, parsePtr) * for the empty range, so that there is always at least one * token added. */ + if (parsePtr->numTokens == parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; + tokenPtr->start = src; + tokenPtr->numComponents = 0; + finishToken: tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 0; parsePtr->numTokens++; @@ -679,7 +946,7 @@ ParseTokens(src, mask, parsePtr) parsePtr->term = src; return TCL_OK; } - + /* *---------------------------------------------------------------------- * @@ -708,7 +975,7 @@ Tcl_FreeParse(parsePtr) parsePtr->tokenPtr = parsePtr->staticTokens; } } - + /* *---------------------------------------------------------------------- * @@ -746,14 +1013,15 @@ TclExpandTokenArray(parsePtr) parsePtr->tokenPtr = newPtr; parsePtr->tokensAvailable = newCount; } - + /* *---------------------------------------------------------------------- * * Tcl_ParseVarName -- * * Given a string starting with a $ sign, parse off a variable - * name and return information about the parse. + * name and return information about the parse. No more than + * numBytes bytes will be scanned. * * Results: * The return value is TCL_OK if the command was parsed @@ -780,9 +1048,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* String containing variable name. First + CONST char *string; /* String containing variable name. First * character must be "$". */ - int numBytes; /* Total number of bytes in string. If < 0, + register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to the * first null character. */ Tcl_Parse *parsePtr; /* Structure to fill in with information @@ -793,16 +1061,17 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) * it. */ { Tcl_Token *tokenPtr; - char *end, *src; + register CONST char *src; unsigned char c; int varIndex, offset; Tcl_UniChar ch; unsigned array; - if (numBytes >= 0) { - end = string + numBytes; - } else { - end = string + strlen(string); + if ((numBytes == 0) || (string == NULL)) { + return TCL_ERROR; + } + if (numBytes < 0) { + numBytes = strlen(string); } if (!append) { @@ -811,7 +1080,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = string; - parsePtr->end = end; + parsePtr->end = (string + numBytes); parsePtr->interp = interp; parsePtr->errorType = TCL_PARSE_SUCCESS; parsePtr->incomplete = 0; @@ -833,8 +1102,8 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) varIndex = parsePtr->numTokens; parsePtr->numTokens++; tokenPtr++; - src++; - if (src >= end) { + src++; numBytes--; + if (numBytes == 0) { goto justADollarSign; } tokenPtr->type = TCL_TOKEN_TEXT; @@ -859,26 +1128,23 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) */ if (*src == '{') { - src++; + src++; numBytes--; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; - while (1) { - if (src == end) { - if (interp != NULL) { - Tcl_SetResult(interp, - "missing close-brace for variable name", + + while (numBytes && (*src != '}')) { + numBytes--; src++; + } + if (numBytes == 0) { + if (interp != NULL) { + Tcl_SetResult(interp, "missing close-brace for variable name", TCL_STATIC); - } - parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; - parsePtr->term = tokenPtr->start-1; - parsePtr->incomplete = 1; - goto error; - } - if (*src == '}') { - break; } - src++; + parsePtr->errorType = TCL_PARSE_MISSING_VAR_BRACE; + parsePtr->term = tokenPtr->start-1; + parsePtr->incomplete = 1; + goto error; } tokenPtr->size = src - tokenPtr->start; tokenPtr[-1].size = src - tokenPtr[-1].start; @@ -888,17 +1154,24 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src; tokenPtr->numComponents = 0; - while (src != end) { - offset = Tcl_UtfToUniChar(src, &ch); + while (numBytes) { + if (Tcl_UtfCharComplete(src, numBytes)) { + offset = Tcl_UtfToUniChar(src, &ch); + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, src, (size_t) numBytes); + utfBytes[numBytes] = '\0'; + offset = Tcl_UtfToUniChar(utfBytes, &ch); + } c = UCHAR(ch); if (isalnum(c) || (c == '_')) { /* INTL: ISO only, UCHAR. */ - src += offset; + src += offset; numBytes -= offset; continue; } - if ((c == ':') && (((src+1) != end) && (src[1] == ':'))) { - src += 2; - while ((src != end) && (*src == ':')) { - src += 1; + if ((c == ':') && (numBytes != 1) && (src[1] == ':')) { + src += 2; numBytes -= 2; + while (numBytes && (*src == ':')) { + src++; numBytes--; } continue; } @@ -908,9 +1181,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) /* * Support for empty array names here. */ - array = ((src != end) && (*src == '(')); + array = (numBytes && (*src == '(')); tokenPtr->size = src - tokenPtr->start; - if (tokenPtr->size == 0 && !array) { + if ((tokenPtr->size == 0) && !array) { goto justADollarSign; } parsePtr->numTokens++; @@ -921,11 +1194,12 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) * since it could contain any number of substitutions. */ - if (ParseTokens(src+1, TYPE_CLOSE_PAREN, parsePtr) + if (ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN, parsePtr) != TCL_OK) { goto error; } - if ((parsePtr->term == end) || (*parsePtr->term != ')')) { + if ((parsePtr->term == (src + numBytes)) + || (*parsePtr->term != ')')) { if (parsePtr->interp != NULL) { Tcl_SetResult(parsePtr->interp, "missing )", TCL_STATIC); @@ -960,7 +1234,7 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) Tcl_FreeParse(parsePtr); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -986,9 +1260,9 @@ Tcl_ParseVarName(interp, string, numBytes, parsePtr, append) CONST char * Tcl_ParseVar(interp, string, termPtr) Tcl_Interp *interp; /* Context for looking up variable. */ - register char *string; /* String containing variable name. + register CONST char *string; /* String containing variable name. * First character must be "$". */ - char **termPtr; /* If non-NULL, points to word to fill + CONST char **termPtr; /* If non-NULL, points to word to fill * in with character just after last * one in the variable specifier. */ @@ -1035,7 +1309,7 @@ Tcl_ParseVar(interp, string, termPtr) Tcl_ResetResult(interp); return TclGetString(objPtr); } - + /* *---------------------------------------------------------------------- * @@ -1043,7 +1317,8 @@ Tcl_ParseVar(interp, string, termPtr) * * Given a string in braces such as a Tcl command argument or a string * value in a Tcl expression, this procedure parses the string and - * returns information about the parse. + * returns information about the parse. No more than numBytes bytes + * will be scanned. * * Results: * The return value is TCL_OK if the string was parsed successfully and @@ -1069,9 +1344,9 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* String containing the string in braces. + CONST char *string; /* String containing the string in braces. * The first character must be '{'. */ - int numBytes; /* Total number of bytes in string. If < 0, + register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to * the first null character. */ register Tcl_Parse *parsePtr; @@ -1081,35 +1356,35 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) * information in parsePtr; zero means * ignore existing tokens in parsePtr and * reinitialize it. */ - char **termPtr; /* If non-NULL, points to word in which to + CONST char **termPtr; /* If non-NULL, points to word in which to * store a pointer to the character just * after the terminating '}' if the parse * was successful. */ { - char utfBytes[TCL_UTF_MAX]; /* For result of backslash substitution. */ Tcl_Token *tokenPtr; - register char *src, *end; + register CONST char *src; int startIndex, level, length; - if ((numBytes >= 0) || (string == NULL)) { - end = string + numBytes; - } else { - end = string + strlen(string); + if ((numBytes == 0) || (string == NULL)) { + return TCL_ERROR; } - + if (numBytes < 0) { + numBytes = strlen(string); + } + if (!append) { parsePtr->numWords = 0; parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = string; - parsePtr->end = end; + parsePtr->end = (string + numBytes); parsePtr->interp = interp; parsePtr->errorType = TCL_PARSE_SUCCESS; } - src = string+1; + src = string; startIndex = parsePtr->numTokens; if (parsePtr->numTokens == parsePtr->tokensAvailable) { @@ -1117,59 +1392,17 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) } tokenPtr = &parsePtr->tokenPtr[startIndex]; tokenPtr->type = TCL_TOKEN_TEXT; - tokenPtr->start = src; + tokenPtr->start = src+1; tokenPtr->numComponents = 0; level = 1; while (1) { - while (CHAR_TYPE(*src) == TYPE_NORMAL) { - src++; - } - if (*src == '}') { - level--; - if (level == 0) { + while (++src, --numBytes) { + if (CHAR_TYPE(*src) != TYPE_NORMAL) { break; } - src++; - } else if (*src == '{') { - level++; - src++; - } else if (*src == '\\') { - Tcl_UtfBackslash(src, &length, utfBytes); - if (src[1] == '\n') { - /* - * A backslash-newline sequence must be collapsed, even - * inside braces, so we have to split the word into - * multiple tokens so that the backslash-newline can be - * represented explicitly. - */ - - if ((src + 2) == end) { - parsePtr->incomplete = 1; - } - tokenPtr->size = (src - tokenPtr->start); - if (tokenPtr->size != 0) { - parsePtr->numTokens++; - } - if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } - tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; - tokenPtr->type = TCL_TOKEN_BS; - tokenPtr->start = src; - tokenPtr->size = length; - tokenPtr->numComponents = 0; - parsePtr->numTokens++; - - src += length; - tokenPtr++; - tokenPtr->type = TCL_TOKEN_TEXT; - tokenPtr->start = src; - tokenPtr->numComponents = 0; - } else { - src += length; - } - } else if (src == end) { - register int openBrace; /* bool-flag for when scanning back */ + } + if (numBytes == 0) { + register int openBrace = 0; parsePtr->errorType = TCL_PARSE_MISSING_BRACE; parsePtr->term = string; @@ -1177,7 +1410,7 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) if (interp == NULL) { /* * Skip straight to the exit code since we have no - * interpreter to put error messages in. + * interpreter to put error message in. */ goto error; } @@ -1185,22 +1418,22 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) Tcl_SetResult(interp, "missing close-brace", TCL_STATIC); /* - * Guess if the problem is due to comments by searching - * the source string for a possible open brace within the - * context of a comment. Since we aren't performing a - * full Tcl parse, just look for an open brace preceeded - * by a '<whitespace>#' on the same line. + * Guess if the problem is due to comments by searching + * the source string for a possible open brace within the + * context of a comment. Since we aren't performing a + * full Tcl parse, just look for an open brace preceded + * by a '<whitespace>#' on the same line. */ - openBrace = 0; - for (; src>string ; src--) { + + for (; src > string; src--) { switch (*src) { - case '{': - openBrace = 1; + case '{': + openBrace = 1; break; case '\n': - openBrace = 0; + openBrace = 0; break; - case '#': + case '#' : if (openBrace && (isspace(UCHAR(src[-1])))) { Tcl_AppendResult(interp, ": possible unbalanced brace in comment", @@ -1210,37 +1443,84 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) break; } } - goto error; - } else { - src++; - } - } - /* - * Decide if we need to finish emitting a partially-finished token. - * There are 3 cases: - * {abc \newline xyz} or {xyz} - finish emitting "xyz" token - * {abc \newline} - don't emit token after \newline - * {} - finish emitting zero-sized token - * The last case ensures that there is a token (even if empty) that - * describes the braced string. - */ + error: + Tcl_FreeParse(parsePtr); + return TCL_ERROR; + } + switch (*src) { + case '{': + level++; + break; + case '}': + if (--level == 0) { + + /* + * Decide if we need to finish emitting a + * partially-finished token. There are 3 cases: + * {abc \newline xyz} or {xyz} + * - finish emitting "xyz" token + * {abc \newline} + * - don't emit token after \newline + * {} - finish emitting zero-sized token + * + * The last case ensures that there is a token + * (even if empty) that describes the braced string. + */ - if ((src != tokenPtr->start) - || (parsePtr->numTokens == startIndex)) { - tokenPtr->size = (src - tokenPtr->start); - parsePtr->numTokens++; - } - if (termPtr != NULL) { - *termPtr = src+1; + if ((src != tokenPtr->start) + || (parsePtr->numTokens == startIndex)) { + tokenPtr->size = (src - tokenPtr->start); + parsePtr->numTokens++; + } + if (termPtr != NULL) { + *termPtr = src+1; + } + return TCL_OK; + } + break; + case '\\': + TclParseBackslash(src, numBytes, &length, NULL); + if ((length > 1) && (src[1] == '\n')) { + /* + * A backslash-newline sequence must be collapsed, even + * inside braces, so we have to split the word into + * multiple tokens so that the backslash-newline can be + * represented explicitly. + */ + + if (numBytes == 2) { + parsePtr->incomplete = 1; + } + tokenPtr->size = (src - tokenPtr->start); + if (tokenPtr->size != 0) { + parsePtr->numTokens++; + } + if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; + tokenPtr->type = TCL_TOKEN_BS; + tokenPtr->start = src; + tokenPtr->size = length; + tokenPtr->numComponents = 0; + parsePtr->numTokens++; + + src += length - 1; + numBytes -= length - 1; + tokenPtr++; + tokenPtr->type = TCL_TOKEN_TEXT; + tokenPtr->start = src + 1; + tokenPtr->numComponents = 0; + } else { + src += length - 1; + numBytes -= length - 1; + } + break; + } } - return TCL_OK; - - error: - Tcl_FreeParse(parsePtr); - return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1248,7 +1528,8 @@ Tcl_ParseBraces(interp, string, numBytes, parsePtr, append, termPtr) * * Given a double-quoted string such as a quoted Tcl command argument * or a quoted value in a Tcl expression, this procedure parses the - * string and returns information about the parse. + * string and returns information about the parse. No more than + * numBytes bytes will be scanned. * * Results: * The return value is TCL_OK if the string was parsed successfully and @@ -1274,9 +1555,9 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) Tcl_Interp *interp; /* Interpreter to use for error reporting; * if NULL, then no error message is * provided. */ - char *string; /* String containing the quoted string. + CONST char *string; /* String containing the quoted string. * The first character must be '"'. */ - int numBytes; /* Total number of bytes in string. If < 0, + register int numBytes; /* Total number of bytes in string. If < 0, * the string consists of all bytes up to * the first null character. */ register Tcl_Parse *parsePtr; @@ -1286,31 +1567,30 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) * information in parsePtr; zero means * ignore existing tokens in parsePtr and * reinitialize it. */ - char **termPtr; /* If non-NULL, points to word in which to + CONST char **termPtr; /* If non-NULL, points to word in which to * store a pointer to the character just * after the quoted string's terminating * close-quote if the parse succeeds. */ { - char *end; - - if ((numBytes >= 0) || (string == NULL)) { - end = string + numBytes; - } else { - end = string + strlen(string); + if ((numBytes == 0) || (string == NULL)) { + return TCL_ERROR; } - + if (numBytes < 0) { + numBytes = strlen(string); + } + if (!append) { parsePtr->numWords = 0; parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; parsePtr->string = string; - parsePtr->end = end; + parsePtr->end = (string + numBytes); parsePtr->interp = interp; parsePtr->errorType = TCL_PARSE_SUCCESS; } - if (ParseTokens(string+1, TYPE_QUOTE, parsePtr) != TCL_OK) { + if (ParseTokens(string+1, numBytes-1, TYPE_QUOTE, parsePtr) != TCL_OK) { goto error; } if (*parsePtr->term != '"') { @@ -1331,7 +1611,7 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) Tcl_FreeParse(parsePtr); return TCL_ERROR; } - + /* *---------------------------------------------------------------------- * @@ -1353,16 +1633,16 @@ Tcl_ParseQuotedString(interp, string, numBytes, parsePtr, append, termPtr) */ static int -CommandComplete(script, length) - char *script; /* Script to check. */ - int length; /* Number of bytes in script. */ +CommandComplete(script, numBytes) + CONST char *script; /* Script to check. */ + int numBytes; /* Number of bytes in script. */ { Tcl_Parse parse; - char *p, *end; + CONST char *p, *end; int result; p = script; - end = p + length; + end = p + numBytes; while (Tcl_ParseCommand((Tcl_Interp *) NULL, p, end - p, 0, &parse) == TCL_OK) { p = parse.commandStart + parse.commandSize; @@ -1379,7 +1659,7 @@ CommandComplete(script, length) Tcl_FreeParse(&parse); return result; } - + /* *---------------------------------------------------------------------- * @@ -1402,11 +1682,11 @@ CommandComplete(script, length) int Tcl_CommandComplete(script) - char *script; /* Script to check. */ + CONST char *script; /* Script to check. */ { return CommandComplete(script, (int) strlen(script)); } - + /* *---------------------------------------------------------------------- * @@ -1430,13 +1710,13 @@ TclObjCommandComplete(objPtr) Tcl_Obj *objPtr; /* Points to object holding script * to check. */ { - char *script; + CONST char *script; int length; script = Tcl_GetStringFromObj(objPtr, &length); return CommandComplete(script, length); } - + /* *---------------------------------------------------------------------- * diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index 1c6a5f5..077dddb 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -8,11 +8,12 @@ * * Copyright (c) 1997 Sun Microsystems, Inc. * Copyright (c) 1998-2000 by Scriptics Corporation. + * Contributions from Don Porter, NIST, 2002. (not subject to US copyright) * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclParseExpr.c,v 1.14 2002/07/22 10:04:17 dkf Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.15 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -55,16 +56,16 @@ typedef struct ParseInfo { int lexeme; /* Type of last lexeme scanned in expr. * See below for definitions. Corresponds to * size characters beginning at start. */ - char *start; /* First character in lexeme. */ + CONST char *start; /* First character in lexeme. */ int size; /* Number of bytes in lexeme. */ - char *next; /* Position of the next character to be + CONST char *next; /* Position of the next character to be * scanned in the expression string. */ - char *prevEnd; /* Points to the character just after the + CONST char *prevEnd; /* Points to the character just after the * last one in the previous lexeme. Used to * compute size of subexpression tokens. */ - char *originalExpr; /* Points to the start of the expression + CONST char *originalExpr; /* Points to the start of the expression * originally passed to Tcl_ParseExpr. */ - char *lastChar; /* Points just after last byte of expr. */ + CONST char *lastChar; /* Points just after last byte of expr. */ } ParseInfo; /* @@ -148,7 +149,7 @@ static char *lexemeStrings[] = { static int GetLexeme _ANSI_ARGS_((ParseInfo *infoPtr)); static void LogSyntaxError _ANSI_ARGS_((ParseInfo *infoPtr, - char *extraInfo)); + CONST char *extraInfo)); static int ParseAddExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseBitAndExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseBitOrExpr _ANSI_ARGS_((ParseInfo *infoPtr)); @@ -157,13 +158,15 @@ static int ParseCondExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseEqualityExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseLandExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseLorExpr _ANSI_ARGS_((ParseInfo *infoPtr)); +static int ParseMaxDoubleLength _ANSI_ARGS_((CONST char *string, + CONST char *end)); static int ParseMultiplyExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParsePrimaryExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseRelationalExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseShiftExpr _ANSI_ARGS_((ParseInfo *infoPtr)); static int ParseUnaryExpr _ANSI_ARGS_((ParseInfo *infoPtr)); -static void PrependSubExprTokens _ANSI_ARGS_((char *op, - int opBytes, char *src, int srcBytes, +static void PrependSubExprTokens _ANSI_ARGS_((CONST char *op, + int opBytes, CONST char *src, int srcBytes, int firstIndex, ParseInfo *infoPtr)); /* @@ -190,7 +193,8 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op, * Given a string, this procedure parses the first Tcl expression * in the string and returns information about the structure of * the expression. This procedure is the top-level interface to the - * the expression parsing module. + * the expression parsing module. No more that numBytes bytes will + * be scanned. * * Results: * The return value is TCL_OK if the command was parsed successfully @@ -212,7 +216,7 @@ static void PrependSubExprTokens _ANSI_ARGS_((char *op, int Tcl_ParseExpr(interp, string, numBytes, parsePtr) Tcl_Interp *interp; /* Used for error reporting. */ - char *string; /* The source string to parse. */ + CONST char *string; /* The source string to parse. */ int numBytes; /* Number of bytes in string. If < 0, the * string consists of all bytes up to the * first null character. */ @@ -223,7 +227,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) { ParseInfo info; int code; - char savedChar; if (numBytes < 0) { numBytes = (string? strlen(string) : 0); @@ -250,17 +253,6 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) parsePtr->incomplete = 0; /* - * Temporarily overwrite the character just after the end of the - * string with a 0 byte. This acts as a sentinel and reduces the - * number of places where we have to check for the end of the - * input string. The original value of the byte is restored at - * the end of the parse. - */ - - savedChar = string[numBytes]; - string[numBytes] = 0; - - /* * Initialize the ParseInfo structure that holds state while parsing * the expression. */ @@ -290,11 +282,9 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) LogSyntaxError(&info, "extra tokens at end of expression"); goto error; } - string[numBytes] = (char) savedChar; return TCL_OK; error: - string[numBytes] = (char) savedChar; if (parsePtr->tokenPtr != parsePtr->staticTokens) { ckfree((char *) parsePtr->tokenPtr); } @@ -310,7 +300,7 @@ Tcl_ParseExpr(interp, string, numBytes, parsePtr) * condExpr ::= lorExpr ['?' condExpr ':' condExpr] * * Note that this is the topmost recursive-descent parsing routine used - * by TclParseExpr to parse expressions. This avoids an extra procedure + * by Tcl_ParseExpr to parse expressions. This avoids an extra procedure * call since such a procedure would only return the result of calling * ParseCondExpr. Other recursive-descent procedures that need to parse * complete expressions also call ParseCondExpr. @@ -336,7 +326,7 @@ ParseCondExpr(infoPtr) Tcl_Parse *parsePtr = infoPtr->parsePtr; Tcl_Token *tokenPtr, *firstTokenPtr, *condTokenPtr; int firstIndex, numToMove, code; - char *srcStart; + CONST char *srcStart; HERE("condExpr", 1); srcStart = infoPtr->start; @@ -449,7 +439,7 @@ ParseLorExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("lorExpr", 2); srcStart = infoPtr->start; @@ -509,7 +499,7 @@ ParseLandExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("landExpr", 3); srcStart = infoPtr->start; @@ -569,7 +559,7 @@ ParseBitOrExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("bitOrExpr", 4); srcStart = infoPtr->start; @@ -630,7 +620,7 @@ ParseBitXorExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("bitXorExpr", 5); srcStart = infoPtr->start; @@ -691,7 +681,7 @@ ParseBitAndExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("bitAndExpr", 6); srcStart = infoPtr->start; @@ -752,7 +742,7 @@ ParseEqualityExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("equalityExpr", 7); srcStart = infoPtr->start; @@ -816,7 +806,7 @@ ParseRelationalExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, operatorSize, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("relationalExpr", 8); srcStart = infoPtr->start; @@ -884,7 +874,7 @@ ParseShiftExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("shiftExpr", 9); srcStart = infoPtr->start; @@ -946,7 +936,7 @@ ParseAddExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("addExpr", 10); srcStart = infoPtr->start; @@ -1008,7 +998,7 @@ ParseMultiplyExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("multiplyExpr", 11); srcStart = infoPtr->start; @@ -1070,7 +1060,7 @@ ParseUnaryExpr(infoPtr) { Tcl_Parse *parsePtr = infoPtr->parsePtr; int firstIndex, lexeme, code; - char *srcStart, *operator; + CONST char *srcStart, *operator; HERE("unaryExpr", 12); srcStart = infoPtr->start; @@ -1135,7 +1125,7 @@ ParsePrimaryExpr(infoPtr) Tcl_Interp *interp = parsePtr->interp; Tcl_Token *tokenPtr, *exprTokenPtr; Tcl_Parse nested; - char *dollarPtr, *stringStart, *termPtr, *src; + CONST char *dollarPtr, *stringStart, *termPtr, *src; int lexeme, exprIndex, firstIndex, numToMove, code; /* @@ -1394,17 +1384,20 @@ ParsePrimaryExpr(infoPtr) * serious as this is only done when generating an error. */ Interp *iPtr = (Interp *) infoPtr->parsePtr->interp; - char savedChar; + Tcl_DString functionName; Tcl_HashEntry *hPtr; /* - * Look up the name as a function name; note that this - * requires the expression to be in writable memory. + * Look up the name as a function name. We need a writable + * copy (DString) so we can terminate it with a NULL for + * the benefit of Tcl_FindHashEntry which operates on + * NULL-terminated string keys. */ - savedChar = tokenPtr->start[tokenPtr->size]; - tokenPtr->start[tokenPtr->size] = '\0'; - hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, tokenPtr->start); - tokenPtr->start[tokenPtr->size] = savedChar; + Tcl_DStringInit(&functionName); + hPtr = Tcl_FindHashEntry(&iPtr->mathFuncTable, + Tcl_DStringAppend(&functionName, tokenPtr->start, + tokenPtr->size)); + Tcl_DStringFree(&functionName); /* * Assume that we have an attempted variable reference @@ -1525,11 +1518,9 @@ GetLexeme(infoPtr) ParseInfo *infoPtr; /* Holds state needed to parse the expr, * including the resulting lexeme. */ { - register char *src; /* Points to current source char. */ - char *termPtr; /* Points to char terminating a literal. */ - double doubleValue; /* Value of a scanned double literal. */ + register CONST char *src; /* Points to current source char. */ char c; - int startsWithDigit, offset; + int offset, length, numBytes; Tcl_Parse *parsePtr = infoPtr->parsePtr; Tcl_Interp *interp = parsePtr->interp; Tcl_UniChar ch; @@ -1543,26 +1534,18 @@ GetLexeme(infoPtr) infoPtr->prevEnd = infoPtr->next; /* - * Scan over leading white space at the start of a lexeme. Note that a - * backslash-newline is treated as a space. + * Scan over leading white space at the start of a lexeme. */ src = infoPtr->next; - c = *src; - while (isspace(UCHAR(c)) || (c == '\\')) { /* INTL: ISO space */ - if (c == '\\') { - if (src[1] == '\n') { - src += 2; - } else { - break; /* no longer white space */ - } - } else { - src++; - } - c = *src; - } + numBytes = parsePtr->end - src; + do { + char type; + int scanned = TclParseWhiteSpace(src, numBytes, parsePtr, &type); + src += scanned; numBytes -= scanned; + } while (numBytes && (*src == '\n') && (src++,numBytes--)); parsePtr->term = src; - if (src >= infoPtr->lastChar) { + if (numBytes == 0) { infoPtr->lexeme = END; infoPtr->next = src; return TCL_OK; @@ -1575,64 +1558,48 @@ GetLexeme(infoPtr) * by mistake, which would eventually cause a syntax error. */ + c = *src; if ((c != '+') && (c != '-')) { - startsWithDigit = isdigit(UCHAR(c)); /* INTL: digit */ - if (startsWithDigit && TclLooksLikeInt(src, -1)) { - errno = 0; -#ifdef TCL_WIDE_INT_IS_LONG - (void) strtoul(src, &termPtr, 0); -#else - (void) strtoull(src, &termPtr, 0); -#endif - if (errno == ERANGE) { - if (interp != NULL) { - char *s = "integer value too large to represent"; - Tcl_ResetResult(interp); - Tcl_AppendToObj(Tcl_GetObjResult(interp), s, -1); - Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, - (char *) NULL); - } + CONST char *end = infoPtr->lastChar; + if ((length = TclParseInteger(src, (end - src)))) { + /* + * First length bytes look like an integer. Verify by + * attempting the conversion to the largest integer we have. + */ + int code; + Tcl_WideInt wide; + Tcl_Obj *value = Tcl_NewStringObj(src, length); + + Tcl_IncrRefCount(value); + code = Tcl_GetWideIntFromObj(interp, value, &wide); + Tcl_DecrRefCount(value); + if (code == TCL_ERROR) { parsePtr->errorType = TCL_PARSE_BAD_NUMBER; return TCL_ERROR; } - if (termPtr != src) { - /* - * src was the start of a valid integer, but was it - * a bad octal? Stopping at a digit would cause that. - */ - if (isdigit(UCHAR(*termPtr))) { /* INTL: digit. */ - /* - * We only want to report an error for the number, - * but we may have something like "08+1" - */ - if (interp != NULL) { - while (isdigit(UCHAR(*(++termPtr)))) {} /* INTL: digit. */ - Tcl_ResetResult(interp); - offset = termPtr - src; - c = src[offset]; - src[offset] = 0; - Tcl_AppendResult(interp, "\"", src, - "\" is an invalid octal number", - (char *) NULL); - src[offset] = c; - } - parsePtr->errorType = TCL_PARSE_BAD_NUMBER; - return TCL_ERROR; - } + infoPtr->lexeme = LITERAL; + infoPtr->start = src; + infoPtr->size = length; + infoPtr->next = (src + length); + parsePtr->term = infoPtr->next; + return TCL_OK; + } else if ((length = ParseMaxDoubleLength(src, end))) { + /* + * There are length characters that could be a double. + * Let strtod() tells us for sure. Need a writable copy + * so we can set an terminating NULL to keep strtod from + * scanning too far. + */ + char *startPtr, *termPtr; + double doubleValue; + Tcl_DString toParse; - infoPtr->lexeme = LITERAL; - infoPtr->start = src; - infoPtr->size = (termPtr - src); - infoPtr->next = termPtr; - parsePtr->term = termPtr; - return TCL_OK; - } - } else if (startsWithDigit || (c == '.') - || (c == 'i') || (c == 'I') /* Could be 'Inf' */ - || (c == 'n') || (c == 'N')) { /* Could be 'NaN' */ errno = 0; - doubleValue = strtod(src, &termPtr); - if (termPtr != src) { + Tcl_DStringInit(&toParse); + startPtr = Tcl_DStringAppend(&toParse, src, length); + doubleValue = strtod(startPtr, &termPtr); + Tcl_DStringFree(&toParse); + if (termPtr != startPtr) { if (errno != 0) { if (interp != NULL) { TclExprFloatError(interp, doubleValue); @@ -1642,14 +1609,19 @@ GetLexeme(infoPtr) } /* - * src was the start of a valid double. + * startPtr was the start of a valid double, copied + * from src. */ infoPtr->lexeme = LITERAL; infoPtr->start = src; - infoPtr->size = (termPtr - src); - infoPtr->next = termPtr; - parsePtr->term = termPtr; + if ((termPtr - startPtr) > length) { + infoPtr->size = length; + } else { + infoPtr->size = (termPtr - startPtr); + } + infoPtr->next = src + infoPtr->size; + parsePtr->term = infoPtr->next; return TCL_OK; } } @@ -1723,72 +1695,69 @@ GetLexeme(infoPtr) return TCL_OK; case '<': - switch (src[1]) { - case '<': - infoPtr->lexeme = LEFT_SHIFT; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - case '=': - infoPtr->lexeme = LEQ; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - default: - infoPtr->lexeme = LESS; - break; + infoPtr->lexeme = LESS; + if ((infoPtr->lastChar - src) > 1) { + switch (src[1]) { + case '<': + infoPtr->lexeme = LEFT_SHIFT; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + case '=': + infoPtr->lexeme = LEQ; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + } } parsePtr->term = infoPtr->next; return TCL_OK; case '>': - switch (src[1]) { - case '>': - infoPtr->lexeme = RIGHT_SHIFT; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - case '=': - infoPtr->lexeme = GEQ; - infoPtr->size = 2; - infoPtr->next = src+2; - break; - default: - infoPtr->lexeme = GREATER; - break; + infoPtr->lexeme = GREATER; + if ((infoPtr->lastChar - src) > 1) { + switch (src[1]) { + case '>': + infoPtr->lexeme = RIGHT_SHIFT; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + case '=': + infoPtr->lexeme = GEQ; + infoPtr->size = 2; + infoPtr->next = src+2; + break; + } } parsePtr->term = infoPtr->next; return TCL_OK; case '=': - if (src[1] == '=') { + infoPtr->lexeme = UNKNOWN; + if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = EQUAL; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = UNKNOWN; } parsePtr->term = infoPtr->next; return TCL_OK; case '!': - if (src[1] == '=') { + infoPtr->lexeme = NOT; + if ((src[1] == '=') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = NEQ; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = NOT; } parsePtr->term = infoPtr->next; return TCL_OK; case '&': - if (src[1] == '&') { + infoPtr->lexeme = BIT_AND; + if ((src[1] == '&') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = AND; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = BIT_AND; } parsePtr->term = infoPtr->next; return TCL_OK; @@ -1798,12 +1767,11 @@ GetLexeme(infoPtr) return TCL_OK; case '|': - if (src[1] == '|') { + infoPtr->lexeme = BIT_OR; + if ((src[1] == '|') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = OR; infoPtr->size = 2; infoPtr->next = src+2; - } else { - infoPtr->lexeme = BIT_OR; } parsePtr->term = infoPtr->next; return TCL_OK; @@ -1813,7 +1781,7 @@ GetLexeme(infoPtr) return TCL_OK; case 'e': - if (src[1] == 'q') { + if ((src[1] == 'q') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = STREQ; infoPtr->size = 2; infoPtr->next = src+2; @@ -1824,7 +1792,7 @@ GetLexeme(infoPtr) } case 'n': - if (src[1] == 'e') { + if ((src[1] == 'e') && ((infoPtr->lastChar - src) > 1)) { infoPtr->lexeme = STRNEQ; infoPtr->size = 2; infoPtr->next = src+2; @@ -1836,13 +1804,28 @@ GetLexeme(infoPtr) default: checkFuncName: - offset = Tcl_UtfToUniChar(src, &ch); + length = (infoPtr->lastChar - src); + if (Tcl_UtfCharComplete(src, length)) { + offset = Tcl_UtfToUniChar(src, &ch); + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, src, (size_t) length); + utfBytes[length] = '\0'; + offset = Tcl_UtfToUniChar(utfBytes, &ch); + } c = UCHAR(ch); if (isalpha(UCHAR(c))) { /* INTL: ISO only. */ infoPtr->lexeme = FUNC_NAME; while (isalnum(UCHAR(c)) || (c == '_')) { /* INTL: ISO only. */ - src += offset; - offset = Tcl_UtfToUniChar(src, &ch); + src += offset; length -= offset; + if (Tcl_UtfCharComplete(src, length)) { + offset = Tcl_UtfToUniChar(src, &ch); + } else { + char utfBytes[TCL_UTF_MAX]; + memcpy(utfBytes, src, (size_t) length); + utfBytes[length] = '\0'; + offset = Tcl_UtfToUniChar(utfBytes, &ch); + } c = UCHAR(ch); } infoPtr->size = (src - infoPtr->start); @@ -1902,6 +1885,107 @@ GetLexeme(infoPtr) /* *---------------------------------------------------------------------- * + * TclParseInteger -- + * + * Scans up to numBytes bytes starting at src, and checks whether + * the leading bytes look like an integer's string representation. + * + * Results: + * Returns 0 if the leading bytes do not look like an integer. + * Otherwise, returns the number of bytes examined that look + * like an integer. This may be less than numBytes if the integer + * is only the leading part of the string. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +int +TclParseInteger(string, numBytes) + register CONST char *string;/* The string to examine. */ + register int numBytes; /* Max number of bytes to scan. */ +{ + register CONST char *p = string; + + /* Take care of introductory "0x" */ + if ((numBytes > 1) && (p[0] == '0') && ((p[1] == 'x') || (p[1] == 'X'))) { + int scanned; + Tcl_UniChar ch; + p+=2; numBytes -= 2; + scanned = TclParseHex(p, numBytes, &ch); + if (scanned) { + return scanned + 2; + } + return 0; + } + while (numBytes && isdigit(UCHAR(*p))) { /* INTL: digit */ + numBytes--; p++; + } + if (numBytes == 0) { + return (p - string); + } + if ((*p != '.') && (*p != 'e') && (*p != 'E')) { + return (p - string); + } + return 0; +} + +/* + *---------------------------------------------------------------------- + * + * ParseMaxDoubleLength -- + * + * Scans a sequence of bytes checking that the characters could + * be in a string rep of a double. + * + * Results: + * Returns the number of bytes starting with string, runing to, but + * not including end, all of which could be part of a string rep. + * of a double. Only character identity is used, no actual + * parsing is done. + * + * The legal bytes are '0' - '9', 'A' - 'F', 'a' - 'f', + * '.', '+', '-', 'i', 'I', 'n', 'N', 'p', 'P', 'x', and 'X'. + * This covers the values "Inf" and "Nan" as well as the + * decimal and hexadecimal representations recognized by a + * C99-compliant strtod(). + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +ParseMaxDoubleLength(string, end) + register CONST char *string;/* The string to examine. */ + CONST char *end; /* Point to the first character past the end + * of the string we are examining. */ +{ + CONST char *p = string; + while (p < end) { + switch (*p) { + case '0': case '1': case '2': case '3': case '4': case '5': + case '6': case '7': case '8': case '9': case 'A': case 'B': + case 'C': case 'D': case 'E': case 'F': case 'I': case 'N': + case 'P': case 'X': case 'a': case 'b': case 'c': case 'd': + case 'e': case 'f': case 'i': case 'n': case 'p': case 'x': + case '.': case '+': case '-': + p++; + break; + default: + goto done; + } + } + done: + return (p - string); +} + +/* + *---------------------------------------------------------------------- + * * PrependSubExprTokens -- * * This procedure is called after the operands of an subexpression have @@ -1921,10 +2005,10 @@ GetLexeme(infoPtr) static void PrependSubExprTokens(op, opBytes, src, srcBytes, firstIndex, infoPtr) - char *op; /* Points to first byte of the operator + CONST char *op; /* Points to first byte of the operator * in the source script. */ int opBytes; /* Number of bytes in the operator. */ - char *src; /* Points to first byte of the subexpression + CONST char *src; /* Points to first byte of the subexpression * in the source script. */ int srcBytes; /* Number of bytes in subexpression's * source. */ @@ -1984,7 +2068,7 @@ static void LogSyntaxError(infoPtr, extraInfo) ParseInfo *infoPtr; /* Holds the parse state for the * expression being parsed. */ - char *extraInfo; /* String to provide extra information + CONST char *extraInfo; /* String to provide extra information * about the syntax error. */ { int numBytes = (infoPtr->lastChar - infoPtr->originalExpr); @@ -1994,8 +2078,8 @@ LogSyntaxError(infoPtr, extraInfo) sprintf(buffer, "syntax error in expression \"%.60s...\"", infoPtr->originalExpr); } else { - sprintf(buffer, "syntax error in expression \"%s\"", - infoPtr->originalExpr); + sprintf(buffer, "syntax error in expression \"%.*s\"", + numBytes, infoPtr->originalExpr); } Tcl_ResetResult(infoPtr->parsePtr->interp); Tcl_AppendStringsToObj(Tcl_GetObjResult(infoPtr->parsePtr->interp), diff --git a/generic/tclProc.c b/generic/tclProc.c index 57829ba..2d16c7f 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.40 2002/07/25 22:06:35 jenglish Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.41 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -798,7 +798,7 @@ TclProcInterpProc(clientData, interp, argc, argv) * invoked. */ int argc; /* Count of number of arguments to this * procedure. */ - register char **argv; /* Argument values. */ + register CONST char **argv; /* Argument values. */ { register Tcl_Obj *objPtr; register int i; diff --git a/generic/tclTest.c b/generic/tclTest.c index 2c952e8..26bc889 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -13,11 +13,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclTest.c,v 1.55 2002/07/22 16:57:47 vincentdarley Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.56 2002/08/05 03:24:41 dgp Exp $ */ #define TCL_TEST - #include "tclInt.h" #include "tclPort.h" @@ -124,9 +123,9 @@ static void CleanupTestSetassocdataTests _ANSI_ARGS_(( static void CmdDelProc1 _ANSI_ARGS_((ClientData clientData)); static void CmdDelProc2 _ANSI_ARGS_((ClientData clientData)); static int CmdProc1 _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int CmdProc2 _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void CmdTraceDeleteProc _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *cmdProc, @@ -138,14 +137,14 @@ static void CmdTraceProc _ANSI_ARGS_((ClientData clientData, int argc, char **argv)); static int CreatedCommandProc _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, - int argc, char **argv)); + int argc, CONST char **argv)); static int CreatedCommandProc2 _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, - int argc, char **argv)); + int argc, CONST char **argv)); static void DelCallbackProc _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp)); static int DelCmdProc _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void DelDeleteProc _ANSI_ARGS_((ClientData clientData)); static void EncodingFreeProc _ANSI_ARGS_((ClientData clientData)); static int EncodingToUtfProc _ANSI_ARGS_((ClientData clientData, @@ -161,10 +160,10 @@ static int EncodingFromUtfProc _ANSI_ARGS_((ClientData clientData, static void ExitProcEven _ANSI_ARGS_((ClientData clientData)); static void ExitProcOdd _ANSI_ARGS_((ClientData clientData)); static int GetTimesCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void MainLoop _ANSI_ARGS_((void)); static int NoopCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int NoopObjCmd _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -181,7 +180,7 @@ static void PrintParse _ANSI_ARGS_((Tcl_Interp *interp, static void SpecialFree _ANSI_ARGS_((char *blockPtr)); static int StaticInitProc _ANSI_ARGS_((Tcl_Interp *interp)); static int TestaccessprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int PretendTclpAccess _ANSI_ARGS_((CONST char *path, int mode)); static int TestAccessProc1 _ANSI_ARGS_((CONST char *path, @@ -191,25 +190,25 @@ static int TestAccessProc2 _ANSI_ARGS_((CONST char *path, static int TestAccessProc3 _ANSI_ARGS_((CONST char *path, int mode)); static int TestasyncCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdinfoCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtokenCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcmdtraceCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestchmodCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestcreatecommandCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdcallCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdelCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdelassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestdstringCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestencodingObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -220,31 +219,31 @@ static int TestevalobjvObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestexprstringCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestfileCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestfilelinkCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestfeventCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetplatformCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetvarfullnameCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestinterpdeleteCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestlinkCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestlocaleCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -255,11 +254,11 @@ static int TestMathFunc2 _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp, Tcl_Value *args, Tcl_Value *resultPtr)); static int TestmainthreadCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetmainloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexitmainloopCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static Tcl_Channel PretendTclpOpenFileChannel _ANSI_ARGS_(( Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)); @@ -273,7 +272,7 @@ static Tcl_Channel TestOpenFileChannelProc3 _ANSI_ARGS_(( Tcl_Interp *interp, CONST char *fileName, CONST char *modeString, int permissions)); static int TestpanicCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestparserObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -293,18 +292,19 @@ static int TestsaveresultCmd _ANSI_ARGS_((ClientData dummy, Tcl_Obj *CONST objv[])); static void TestsaveresultFree _ANSI_ARGS_((char *blockPtr)); static int TestsetassocdataCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetobjerrorcodeCmd _ANSI_ARGS_(( ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -static int TestopenfilechannelprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); +static int TestopenfilechannelprocCmd _ANSI_ARGS_(( + ClientData dummy, Tcl_Interp *interp, int argc, + CONST char **argv)); static int TestsetplatformCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TeststaticpkgCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int PretendTclpStat _ANSI_ARGS_((CONST char *path, struct stat *buf)); static int TestStatProc1 _ANSI_ARGS_((CONST char *path, @@ -314,11 +314,11 @@ static int TestStatProc2 _ANSI_ARGS_((CONST char *path, static int TestStatProc3 _ANSI_ARGS_((CONST char *path, struct stat *buf)); static int TeststatprocCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TesttranslatefilenameCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestupvarCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestWrongNumArgsObjCmd _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -326,9 +326,9 @@ static int TestGetIndexFromObjStructObjCmd _ANSI_ARGS_(( ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); static int TestChannelCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestChannelEventCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); /* Filesystem testing */ static int TestFilesystemObjCmd _ANSI_ARGS_((ClientData dummy, @@ -664,7 +664,7 @@ TestasyncCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TestAsyncHandler *asyncPtr, *prevPtr; int id, code; @@ -738,7 +738,7 @@ TestasyncCmd(dummy, interp, argc, argv) break; } } - Tcl_SetResult(interp, argv[3], TCL_VOLATILE); + Tcl_SetResult(interp, (char *)argv[3], TCL_VOLATILE); return code; } else { Tcl_AppendResult(interp, "bad option \"", argv[1], @@ -757,8 +757,8 @@ AsyncHandlerProc(clientData, interp, code) int code; /* Current return code from command. */ { TestAsyncHandler *asyncPtr = (TestAsyncHandler *) clientData; - CONST char *listArgv[4]; - char string[TCL_INTEGER_SPACE], *cmd; + CONST char *listArgv[4], *cmd; + char string[TCL_INTEGER_SPACE]; TclFormatInt(string, code); listArgv[0] = asyncPtr->command; @@ -775,7 +775,7 @@ AsyncHandlerProc(clientData, interp, code) * checking is needed here. */ } - ckfree(cmd); + ckfree((char *)cmd); return code; } @@ -803,7 +803,7 @@ TestcmdinfoCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_CmdInfo info; @@ -876,7 +876,7 @@ CmdProc1(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc1 ", (char *) clientData, (char *) NULL); @@ -889,7 +889,7 @@ CmdProc2(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_AppendResult(interp, "CmdProc2 ", (char *) clientData, (char *) NULL); @@ -938,7 +938,7 @@ TestcmdtokenCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_Command token; int *l; @@ -1002,7 +1002,7 @@ TestcmdtraceCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_DString buffer; int result; @@ -1176,7 +1176,7 @@ TestcreatecommandCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], @@ -1209,7 +1209,7 @@ CreatedCommandProc(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_CmdInfo info; int found; @@ -1231,7 +1231,7 @@ CreatedCommandProc2(clientData, interp, argc, argv) ClientData clientData; /* String to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_CmdInfo info; int found; @@ -1270,7 +1270,7 @@ TestdcallCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int i, id; @@ -1336,7 +1336,7 @@ TestdelCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { DelCmd *dPtr; Tcl_Interp *slave; @@ -1366,7 +1366,7 @@ DelCmdProc(clientData, interp, argc, argv) ClientData clientData; /* String result to return. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { DelCmd *dPtr = (DelCmd *) clientData; @@ -1411,7 +1411,7 @@ TestdelassocdataCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], @@ -1445,7 +1445,7 @@ TestdstringCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int count; @@ -1852,7 +1852,7 @@ TestexithandlerCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int value; @@ -1920,7 +1920,7 @@ TestexprlongCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { long exprResult; char buf[4 + TCL_INTEGER_SPACE]; @@ -1957,7 +1957,7 @@ TestexprstringCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], @@ -2057,7 +2057,7 @@ TestgetassocdataCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { char *res; @@ -2095,7 +2095,7 @@ TestgetplatformCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static CONST char *platformStrings[] = { "unix", "mac", "windows" }; TclPlatformType *platform; @@ -2140,7 +2140,7 @@ TestinterpdeleteCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_Interp *slaveToDelete; @@ -2181,7 +2181,7 @@ TestlinkCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static int intVar = 43; static int boolVar = 4; @@ -2826,7 +2826,7 @@ TestparsevarObjCmd(clientData, interp, objc, objv) Tcl_Obj *CONST objv[]; /* The argument objects. */ { CONST char *value; - char *name, *termPtr; + CONST char *name, *termPtr; if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "varName"); @@ -3263,7 +3263,7 @@ TestsetassocdataCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { char *buf; char *oldData; @@ -3316,7 +3316,7 @@ TestsetplatformCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { size_t length; TclPlatformType *platform; @@ -3371,7 +3371,7 @@ TeststaticpkgCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int safe, loaded; @@ -3422,7 +3422,7 @@ TesttranslatefilenameCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_DString buffer; CONST char *result; @@ -3464,7 +3464,7 @@ TestupvarCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int flags = 0; @@ -3556,7 +3556,7 @@ TestfeventCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static Tcl_Interp *interp2 = NULL; int code; @@ -3628,18 +3628,18 @@ TestpanicCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { - char *argString; + CONST char *argString; /* * Put the arguments into a var args structure * Append all of the arguments together separated by spaces */ - argString = Tcl_Merge(argc-1, (CONST char **) argv+1); + argString = Tcl_Merge(argc-1, argv+1); panic(argString); - ckfree(argString); + ckfree((char *)argString); return TCL_OK; } @@ -3668,7 +3668,7 @@ TestchmodCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int i, mode; char *rest; @@ -3871,7 +3871,7 @@ GetTimesCmd(unused, interp, argc, argv) ClientData unused; /* Unused. */ Tcl_Interp *interp; /* The current interpreter. */ int argc; /* The number of arguments. */ - char **argv; /* The argument strings. */ + CONST char **argv; /* The argument strings. */ { Interp *iPtr = (Interp *) interp; int i, n; @@ -4051,7 +4051,7 @@ NoopCmd(unused, interp, argc, argv) ClientData unused; /* Unused. */ Tcl_Interp *interp; /* The current interpreter. */ int argc; /* The number of arguments. */ - char **argv; /* The argument strings. */ + CONST char **argv; /* The argument strings. */ { return TCL_OK; } @@ -4106,7 +4106,7 @@ TestsetCmd(data, interp, argc, argv) ClientData data; /* Additional flags for Get/SetVar2. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int flags = (int) data; CONST char *value; @@ -4288,7 +4288,7 @@ TeststatprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TclStatProc_ *proc; int retVal; @@ -4476,7 +4476,7 @@ TestmainthreadCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc == 1) { Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread()); @@ -4536,7 +4536,7 @@ TestsetmainloopCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { exitMainLoop = 0; Tcl_SetMainLoop(MainLoop); @@ -4565,7 +4565,7 @@ TestexitmainloopCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { exitMainLoop = 1; return TCL_OK; @@ -4593,7 +4593,7 @@ TestaccessprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TclAccessProc_ *proc; int retVal; @@ -4705,7 +4705,7 @@ TestopenfilechannelprocCmd (dummy, interp, argc, argv) ClientData dummy; /* Not used. */ register Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { TclOpenFileChannelProc_ *proc; int retVal; @@ -4904,9 +4904,9 @@ TestChannelCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter for result. */ int argc; /* Count of additional args. */ - char **argv; /* Additional arg strings. */ + CONST char **argv; /* Additional arg strings. */ { - char *cmdName; /* Sub command. */ + CONST char *cmdName; /* Sub command. */ Tcl_HashTable *hTblPtr; /* Hash table of channels. */ Tcl_HashSearch hSearch; /* Search variable. */ Tcl_HashEntry *hPtr; /* Search variable. */ @@ -5332,13 +5332,13 @@ TestChannelEventCmd(dummy, interp, argc, argv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_Obj *resultListPtr; Channel *chanPtr; ChannelState *statePtr; /* state info for channel */ EventScriptRecord *esPtr, *prevEsPtr, *nextEsPtr; - char *cmd; + CONST char *cmd; int index, i, mask, len; if ((argc < 3) || (argc > 5)) { @@ -5602,7 +5602,7 @@ TestGetIndexFromObjStructObjCmd(dummy, interp, objc, objv) int objc; /* Number of arguments. */ Tcl_Obj *CONST objv[]; /* Argument objects. */ { - CONST char *ary[] = { + char *ary[] = { "a", "b", "c", "d", "e", "f", (char *)NULL,(char *)NULL }; int idx,target; diff --git a/generic/tclUtf.c b/generic/tclUtf.c index 897d743..0fccf95 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.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: tclUtf.c,v 1.27 2002/07/19 12:31:10 dkf Exp $ + * RCS: @(#) $Id: tclUtf.c,v 1.28 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -778,129 +778,19 @@ Tcl_UtfBackslash(src, readPtr, dst) char *dst; /* Filled with the bytes represented by the * backslash sequence. */ { - register CONST char *p = src+1; - Tcl_UniChar result; - int count, n; - char buf[TCL_UTF_MAX]; - - if (dst == NULL) { - dst = buf; +#define LINE_LENGTH 128 + int numRead; + int result; + + result = TclParseBackslash(src, LINE_LENGTH, &numRead, dst); + if (numRead == LINE_LENGTH) { + /* We ate a whole line. Pay the price of a strlen() */ + result = TclParseBackslash(src, (int)strlen(src), &numRead, dst); } - - count = 2; - switch (*p) { - /* - * Note: in the conversions below, use absolute values (e.g., - * 0xa) rather than symbolic values (e.g. \n) that get converted - * by the compiler. It's possible that compilers on some - * platforms will do the symbolic conversions differently, which - * could result in non-portable Tcl scripts. - */ - - case 'a': - result = 0x7; - break; - case 'b': - result = 0x8; - break; - case 'f': - result = 0xc; - break; - case 'n': - result = 0xa; - break; - case 'r': - result = 0xd; - break; - case 't': - result = 0x9; - break; - case 'v': - result = 0xb; - break; - case 'x': - if (isxdigit(UCHAR(p[1]))) { /* INTL: digit */ - char *end; - - result = (unsigned char) strtoul(p+1, &end, 16); - count = end - src; - } else { - count = 2; - result = 'x'; - } - break; - case 'u': - result = 0; - for (count = 0; count < 4; count++) { - p++; - if (!isxdigit(UCHAR(*p))) { /* INTL: digit */ - break; - } - n = *p - '0'; - if (n > 9) { - n = n + '0' + 10 - 'A'; - } - if (n > 16) { - n = n + 'A' - 'a'; - } - result = (result << 4) + n; - } - if (count == 0) { - result = 'u'; - } - count += 2; - break; - - case '\n': - do { - p++; - } while ((*p == ' ') || (*p == '\t')); - result = ' '; - count = p - src; - break; - case 0: - result = '\\'; - count = 1; - break; - default: - /* - * Check for an octal number \oo?o? - */ - if (isdigit(UCHAR(*p)) && (UCHAR(*p) < '8')) { /* INTL: digit */ - result = (unsigned char)(*p - '0'); - p++; - if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */ - break; - } - count = 3; - result = (unsigned char)((result << 3) + (*p - '0')); - p++; - if (!isdigit(UCHAR(*p)) || (UCHAR(*p) >= '8')) { /* INTL: digit */ - break; - } - count = 4; - result = (unsigned char)((result << 3) + (*p - '0')); - break; - } - if (UCHAR(*p) < UNICODE_SELF) { - result = *p; - count = 2; - } else { - /* - * We have to convert here because the user has put a - * backslash in front of a multi-byte utf-8 character. - * While this means nothing special, we shouldn't break up - * a correct utf-8 character. [Bug #217987] test subst-3.2 - */ - count = Tcl_UtfToUniChar(p, &result) + 1; /* +1 for '\' */ - } - break; - } - if (readPtr != NULL) { - *readPtr = count; + *readPtr = numRead; } - return Tcl_UniCharToUtf((int) result, dst); + return result; } /* diff --git a/generic/tclUtil.c b/generic/tclUtil.c index ff5e53a..683f752 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -11,7 +11,7 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclUtil.c,v 1.32 2002/06/25 08:59:36 dkf Exp $ + * RCS: @(#) $Id: tclUtil.c,v 1.33 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -947,7 +947,7 @@ Tcl_Backslash(src, readPtr) *---------------------------------------------------------------------- */ -char * +CONST char * Tcl_Concat(argc, argv) int argc; /* Number of strings to concatenate. */ CONST char * CONST *argv; /* Array of strings to concatenate. */ @@ -1878,7 +1878,7 @@ char * TclPrecTraceProc(clientData, interp, name1, name2, flags) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Interpreter containing variable. */ - char *name1; /* Name of variable. */ + CONST char *name1; /* Name of variable. */ CONST char *name2; /* Second part of variable name. */ int flags; /* Information about what happened. */ { @@ -2124,38 +2124,28 @@ TclLooksLikeInt(bytes, length) * considered (if they may appear in an * integer). */ { - register CONST char *p, *end; + register CONST char *p; + + if ((bytes == NULL) && (length > 0)) { + Tcl_Panic("TclLooksLikeInt: cannot scan %d bytes from NULL", length); + } if (length < 0) { - length = (bytes? strlen(bytes) : 0); + length = (bytes? strlen(bytes) : 0); } - end = (bytes + length); p = bytes; - while ((p < end) && isspace(UCHAR(*p))) { /* INTL: ISO space. */ - p++; + while (length && isspace(UCHAR(*p))) { /* INTL: ISO space. */ + length--; p++; } - if (p == end) { - return 0; + if (length == 0) { + return 0; } - if ((*p == '+') || (*p == '-')) { - p++; - } - if ((p == end) || !isdigit(UCHAR(*p))) { /* INTL: digit */ - return 0; - } - p++; - while ((p < end) && isdigit(UCHAR(*p))) { /* INTL: digit */ - p++; - } - if (p == end) { - return 1; + p++; length--; } - if ((*p != '.') && (*p != 'e') && (*p != 'E')) { - return 1; - } - return 0; + + return (0 != TclParseInteger(p, length)); } /* diff --git a/generic/tclVar.c b/generic/tclVar.c index b43778e..48cc6e1 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.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: tclVar.c,v 1.62 2002/07/27 01:44:24 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.63 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -43,13 +43,13 @@ static CONST char *isArrayElement = "name refers to an element in an array"; */ static int CallVarTraces _ANSI_ARGS_((Interp *iPtr, Var *arrayPtr, - Var *varPtr, char *part1, CONST char *part2, + Var *varPtr, CONST char *part1, CONST char *part2, int flags, CONST int leaveErrMsg)); static void CleanupVar _ANSI_ARGS_((Var *varPtr, Var *arrayPtr)); static void DeleteSearches _ANSI_ARGS_((Var *arrayVarPtr)); static void DeleteArray _ANSI_ARGS_((Interp *iPtr, - char *arrayName, Var *varPtr, int flags)); + CONST char *arrayName, Var *varPtr, int flags)); static void DisposeTraceResult _ANSI_ARGS_((int flags, char *result)); static int ObjMakeUpvar _ANSI_ARGS_((Tcl_Interp *interp, @@ -182,7 +182,7 @@ Var * TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, arrayPtrPtr) Tcl_Interp *interp; /* Interpreter to use for lookup. */ - register char *part1; /* If part2 isn't NULL, this is the name of + CONST char *part1; /* If part2 isn't NULL, this is the name of * an array. Otherwise, this * is a full variable name that could * include a parenthesized array element. */ @@ -206,19 +206,21 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, Var *varPtr; CONST char *elName; /* Name of array element or NULL; may be * same as part2, or may be openParen+1. */ - char *openParen, *closeParen; + int openParen, closeParen; /* If this procedure parses a name into - * array and index, these point to the - * parens around the index. Otherwise they - * are NULL. These are needed to restore - * the parens after parsing the name. */ - register char *p; + * array and index, these are the offsets to + * the parens around the index. Otherwise + * they are -1. */ + register CONST char *p; CONST char *errMsg = NULL; int index; +#define VAR_NAME_BUF_SIZE 26 + char buffer[VAR_NAME_BUF_SIZE]; + char *newVarName = buffer; varPtr = NULL; *arrayPtrPtr = NULL; - openParen = closeParen = NULL; + openParen = closeParen = -1; /* * Parse part1 into array name and index. @@ -233,7 +235,7 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, elName = part2; for (p = part1; *p ; p++) { if (*p == '(') { - openParen = p; + openParen = p - part1; do { p++; } while (*p != '\0'); @@ -245,16 +247,23 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, } return NULL; } - closeParen = p; - *openParen = 0; - *closeParen = 0; - elName = openParen+1; + closeParen = p - part1; } else { - openParen = NULL; + openParen = -1; } break; } } + if (openParen != -1) { + if (closeParen >= VAR_NAME_BUF_SIZE) { + newVarName = ckalloc((unsigned int) (closeParen+1)); + } + memcpy(newVarName, part1, (unsigned int) closeParen); + newVarName[openParen] = '\0'; + newVarName[closeParen] = '\0'; + part1 = newVarName; + elName = newVarName + openParen + 1; + } varPtr = TclLookupSimpleVar(interp, part1, flags, createPart1, &errMsg, &index); @@ -272,12 +281,13 @@ TclLookupVar(interp, part1, part2, flags, msg, createPart1, createPart2, msg, createPart1, createPart2, varPtr); } } - - if (openParen != NULL) { - *openParen = '('; - *closeParen = ')'; + if (newVarName != buffer) { + ckfree(newVarName); } + return varPtr; + +#undef VAR_NAME_BUF_SIZE } /* @@ -969,7 +979,7 @@ CONST char * Tcl_GetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *varName; /* Name of a variable in interp. */ + CONST char *varName; /* Name of a variable in interp. */ int flags; /* OR-ed combination of TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY or TCL_LEAVE_ERR_MSG * bits. */ @@ -1004,7 +1014,7 @@ CONST char * Tcl_GetVar2(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1048,7 +1058,7 @@ Tcl_Obj * Tcl_GetVar2Ex(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1159,7 +1169,7 @@ TclPtrGetVar(interp, varPtr, arrayPtr, part1, part2, flags) register Var *varPtr; /* The variable to be read.*/ Var *arrayPtr; /* NULL for scalar variables, pointer to * the containing array otherwise. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1291,7 +1301,7 @@ CONST char * Tcl_SetVar(interp, varName, newValue, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *varName; /* Name of a variable in interp. */ + CONST char *varName; /* Name of a variable in interp. */ CONST char *newValue; /* New value for varName. */ int flags; /* Various flags that tell how to set value: * any of TCL_GLOBAL_ONLY, @@ -1332,7 +1342,7 @@ CONST char * Tcl_SetVar2(interp, part1, part2, newValue, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be looked up. */ - char *part1; /* If part2 is NULL, this is name of scalar + CONST char *part1; /* If part2 is NULL, this is name of scalar * variable. Otherwise it is the name of * an array. */ CONST char *part2; /* Name of an element within an array, or @@ -1405,7 +1415,7 @@ Tcl_Obj * Tcl_SetVar2Ex(interp, part1, part2, newValuePtr, flags) Tcl_Interp *interp; /* Command interpreter in which variable is * to be found. */ - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1516,7 +1526,7 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags) * to be looked up. */ register Var *varPtr; Var *arrayPtr; - char *part1; /* Name of an array (if part2 is non-NULL) + CONST char *part1; /* Name of an array (if part2 is non-NULL) * or the name of a variable. */ CONST char *part2; /* If non-NULL, gives the name of an element * in the array part1. */ @@ -1772,7 +1782,7 @@ TclPtrIncrVar(interp, varPtr, arrayPtr, part1, part2, incrAmount, flags) * to be found. */ Var *varPtr; Var *arrayPtr; - char *part1; /* Points to an object holding the name of + CONST char *part1; /* Points to an object holding the name of * an array (if part2 is non-NULL) or the * name of a variable. */ CONST char *part2; /* If non-null, points to an object holding @@ -1877,7 +1887,7 @@ int Tcl_UnsetVar(interp, varName, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *varName; /* Name of a variable in interp. May be + CONST char *varName; /* Name of a variable in interp. May be * either a scalar name or an array name * or an element in an array. */ int flags; /* OR-ed combination of any of @@ -1912,7 +1922,7 @@ int Tcl_UnsetVar2(interp, part1, part2, flags) Tcl_Interp *interp; /* Command interpreter in which varName is * to be looked up. */ - char *part1; /* Name of variable or array. */ + CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array or NULL. */ int flags; /* OR-ed combination of any of * TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, @@ -2124,7 +2134,7 @@ int Tcl_TraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is * to be traced. */ - char *varName; /* Name of variable; may end with "(index)" + CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed collection of bits, including any * of TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -2163,7 +2173,7 @@ int Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter in which variable is * to be traced. */ - char *part1; /* Name of scalar variable or array. */ + CONST char *part1; /* Name of scalar variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ @@ -2241,7 +2251,7 @@ Tcl_TraceVar2(interp, part1, part2, flags, proc, clientData) void Tcl_UntraceVar(interp, varName, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *varName; /* Name of variable; may end with "(index)" + CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed collection of bits describing * current trace, including any of @@ -2275,7 +2285,7 @@ Tcl_UntraceVar(interp, varName, flags, proc, clientData) void Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *part1; /* Name of variable or array. */ + CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ @@ -2386,7 +2396,7 @@ Tcl_UntraceVar2(interp, part1, part2, flags, proc, clientData) ClientData Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *varName; /* Name of variable; may end with "(index)" + CONST char *varName; /* Name of variable; may end with "(index)" * to signify an array reference. */ int flags; /* OR-ed combo or TCL_GLOBAL_ONLY, * TCL_NAMESPACE_ONLY (can be 0). */ @@ -2421,7 +2431,7 @@ Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) ClientData Tcl_VarTraceInfo2(interp, part1, part2, flags, proc, prevClientData) Tcl_Interp *interp; /* Interpreter containing variable. */ - char *part1; /* Name of variable or array. */ + CONST char *part1; /* Name of variable or array. */ CONST char *part2; /* Name of element within array; NULL means * trace applies to scalar variable or array * as-a-whole. */ @@ -3581,7 +3591,7 @@ Tcl_UpVar(interp, frameName, varName, localName, flags) * to be looked up. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ - char *varName; /* Name of a variable in interp to link to. + CONST char *varName; /* Name of a variable in interp to link to. * May be either a scalar name or an * element in an array. */ CONST char *localName; /* Name of link variable. */ @@ -3618,7 +3628,7 @@ Tcl_UpVar2(interp, frameName, part1, part2, localName, flags) * for error messages too. */ CONST char *frameName; /* Name of the frame containing the source * variable, such as "1" or "#0". */ - char *part1; + CONST char *part1; CONST char *part2; /* Two parts of source variable name to * link to. */ CONST char *localName; /* Name of link variable. */ @@ -4058,7 +4068,7 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) * isn't an element of an array. */ Var *varPtr; /* Variable whose traces are to be * invoked. */ - char *part1; + CONST char *part1; CONST char *part2; /* Variable's two-part name. */ int flags; /* Flags passed to trace procedures: * indicates what's happening to variable, @@ -4071,7 +4081,8 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) { register VarTrace *tracePtr; ActiveVarTrace active; - char *result, *openParen, *p; + char *result; + CONST char *openParen, *p; Tcl_DString nameCopy; int copiedName; int code = TCL_OK; @@ -4111,11 +4122,13 @@ CallVarTraces(iPtr, arrayPtr, varPtr, part1, part2, flags, leaveErrMsg) p--; if (*p == ')') { int offset = (openParen - part1); + char *newPart1; Tcl_DStringInit(&nameCopy); Tcl_DStringAppend(&nameCopy, part1, (p-part1)); - part2 = Tcl_DStringValue(&nameCopy) + offset + 1; - part1 = Tcl_DStringValue(&nameCopy); - part1[offset] = 0; + newPart1 = Tcl_DStringValue(&nameCopy); + newPart1[offset] = 0; + part1 = newPart1; + part2 = newPart1 + offset + 1; copiedName = 1; } break; @@ -4727,7 +4740,7 @@ TclDeleteCompiledLocalVars(iPtr, framePtr) static void DeleteArray(iPtr, arrayName, varPtr, flags) Interp *iPtr; /* Interpreter containing array. */ - char *arrayName; /* Name of array (used for trace + CONST char *arrayName; /* Name of array (used for trace * callbacks). */ Var *varPtr; /* Pointer to variable structure. */ int flags; /* Flags to pass to CallVarTraces: @@ -4886,7 +4899,7 @@ VarErrMsg(interp, part1, part2, operation, reason) Var * TclVarTraceExists(interp, varName) Tcl_Interp *interp; /* The interpreter */ - char *varName; /* The variable name */ + CONST char *varName; /* The variable name */ { Var *varPtr; Var *arrayPtr; diff --git a/mac/tclMacTest.c b/mac/tclMacTest.c index 9598848..92becad 100644 --- a/mac/tclMacTest.c +++ b/mac/tclMacTest.c @@ -9,11 +9,11 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclMacTest.c,v 1.4 1999/05/11 07:13:36 jingham Exp $ + * RCS: @(#) $Id: tclMacTest.c,v 1.5 2002/08/05 03:24:41 dgp Exp $ */ #define TCL_TEST - +#define USE_COMPAT_CONST #include "tclInt.h" #include "tclMacInt.h" #include "tclMacPort.h" diff --git a/tests/expr-old.test b/tests/expr-old.test index a90366e..32f737a 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -13,10 +13,10 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: expr-old.test,v 1.15 2002/07/26 18:51:02 msofer Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.16 2002/08/05 03:24:41 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { - package require tcltest + package require tcltest 2.1 namespace import -force ::tcltest::* } @@ -899,9 +899,9 @@ if $gotT1 { } {1 {too many arguments for math function}} } -test expr-old-36.1 {ExprLooksLikeInt procedure} { - list [catch {expr 0289} msg] $msg -} {1 {"0289" is an invalid octal number}} +test expr-old-36.1 {ExprLooksLikeInt procedure} -body { + expr 0289 +} -returnCodes error -match glob -result {*invalid octal number*} test expr-old-36.2 {ExprLooksLikeInt procedure} { set x 0289 list [catch {expr {$x+1}} msg] $msg diff --git a/tests/parseExpr.test b/tests/parseExpr.test index 958c515..489e6d2 100644 --- a/tests/parseExpr.test +++ b/tests/parseExpr.test @@ -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: parseExpr.test,v 1.7 2001/12/06 10:59:18 dkf Exp $ +# RCS: @(#) $Id: parseExpr.test,v 1.8 2002/08/05 03:24:41 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -509,9 +509,11 @@ test parseExpr-16.4 {GetLexeme procedure, integer lexeme} { test parseExpr-16.5 {GetLexeme procedure, integer lexeme too big} {wideIntegerUnparsed} { list [catch {testexprparser {12345678901234567890} -1} msg] $msg } {1 {integer value too large to represent}} -test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} { - list [catch {testexprparser {0999} -1} msg] $msg -} {1 {"0999" is an invalid octal number}} + +test parseExpr-16.6 {GetLexeme procedure, bad integer lexeme} -body { + testexprparser {0999} -1 +} -returnCodes error -match glob -result {*invalid octal number*} + test parseExpr-16.7 {GetLexeme procedure, double lexeme} { testexprparser {0.999} -1 } {- {} 0 subexpr 0.999 1 text 0.999 0 {}} diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index d556a2b..027c26a 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.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: tclUnixTest.c,v 1.11 1999/10/13 00:32:50 hobbs Exp $ + * RCS: @(#) $Id: tclUnixTest.c,v 1.12 2002/08/05 03:24:41 dgp Exp $ */ #include "tclInt.h" @@ -66,22 +66,22 @@ static char *gotsig = "0"; static void TestFileHandlerProc _ANSI_ARGS_((ClientData clientData, int mask)); static int TestfilehandlerCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestfilewaitCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestfindexecutableCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetopenfileCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgetdefencdirCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestsetdefencdirCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); int TclplatformtestInit _ANSI_ARGS_((Tcl_Interp *interp)); static int TestalarmCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static int TestgotsigCmd _ANSI_ARGS_((ClientData dummy, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); static void AlarmHandler _ANSI_ARGS_(()); /* @@ -147,7 +147,7 @@ TestfilehandlerCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Pipe *pipePtr; int i, mask, timeout; @@ -374,7 +374,7 @@ TestfilewaitCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { int mask, result, timeout; Tcl_Channel channel; @@ -443,7 +443,7 @@ TestfindexecutableCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { char *oldName; char *oldNativeName; @@ -497,7 +497,7 @@ TestgetopenfileCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { ClientData filePtr; @@ -542,7 +542,7 @@ TestsetdefencdirCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 2) { Tcl_AppendResult(interp, @@ -586,7 +586,7 @@ TestgetdefencdirCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { if (argc != 1) { Tcl_AppendResult(interp, @@ -623,7 +623,7 @@ TestalarmCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { #ifdef SA_RESTART unsigned int sec; @@ -700,7 +700,7 @@ TestgotsigCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { Tcl_AppendResult(interp, gotsig, (char *) NULL); gotsig = "0"; diff --git a/unix/tclXtTest.c b/unix/tclXtTest.c index abdcb8d..d0b07a5 100644 --- a/unix/tclXtTest.c +++ b/unix/tclXtTest.c @@ -8,14 +8,14 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclXtTest.c,v 1.4 1999/07/02 06:05:34 welch Exp $ + * RCS: @(#) $Id: tclXtTest.c,v 1.5 2002/08/05 03:24:41 dgp Exp $ */ #include <X11/Intrinsic.h> #include "tcl.h" static int TesteventloopCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int argc, char **argv)); + Tcl_Interp *interp, int argc, CONST char **argv)); extern void InitNotifier _ANSI_ARGS_((void)); @@ -75,7 +75,7 @@ TesteventloopCmd(clientData, interp, argc, argv) ClientData clientData; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int argc; /* Number of arguments. */ - char **argv; /* Argument strings. */ + CONST char **argv; /* Argument strings. */ { static int *framePtr = NULL; /* Pointer to integer on stack frame of * innermost invocation of the "wait" diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 6a6825c..bda1f11 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -8,9 +8,10 @@ * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclWinTest.c,v 1.6 2001/11/21 02:36:21 hobbs Exp $ + * RCS: @(#) $Id: tclWinTest.c,v 1.7 2002/08/05 03:24:41 dgp Exp $ */ +#define USE_COMPAT_CONST #include "tclWinInt.h" /* |