Attachment "complete.patch" to
ticket [585105ffff]
added by
dgp
2002-07-25 08:44:25.
Index: doc/CmdCmplt.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CmdCmplt.3,v
retrieving revision 1.2
diff -u -r1.2 CmdCmplt.3
--- doc/CmdCmplt.3 14 Sep 1998 18:39:46 -0000 1.2
+++ doc/CmdCmplt.3 25 Jul 2002 01:29:57 -0000
@@ -19,8 +19,8 @@
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
Index: doc/Concat.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/Concat.3,v
retrieving revision 1.4
diff -u -r1.4 Concat.3
--- doc/Concat.3 25 Jan 2002 20:40:55 -0000 1.4
+++ doc/Concat.3 25 Jul 2002 01:29:57 -0000
@@ -16,7 +16,7 @@
.nf
\fB#include <tcl.h>\fR
.sp
-char *
+CONST char *
\fBTcl_Concat\fR(\fIargc, argv\fR)
.SH ARGUMENTS
.AP int argc in
Index: doc/CrtCommand.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CrtCommand.3,v
retrieving revision 1.4
diff -u -r1.4 CrtCommand.3
--- doc/CrtCommand.3 24 Apr 2001 20:59:17 -0000 1.4
+++ doc/CrtCommand.3 25 Jul 2002 01:29:57 -0000
@@ -84,7 +84,7 @@
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
Index: doc/CrtSlave.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CrtSlave.3,v
retrieving revision 1.7
diff -u -r1.7 CrtSlave.3
--- doc/CrtSlave.3 1 Jul 2002 18:24:39 -0000 1.7
+++ doc/CrtSlave.3 25 Jul 2002 01:29:58 -0000
@@ -73,7 +73,7 @@
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 @@
.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.
Index: doc/CrtTrace.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/CrtTrace.3,v
retrieving revision 1.5
diff -u -r1.5 CrtTrace.3
--- doc/CrtTrace.3 17 Jun 2002 22:52:50 -0000 1.5
+++ doc/CrtTrace.3 25 Jul 2002 01:29:58 -0000
@@ -165,7 +165,7 @@
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
Index: doc/Eval.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/Eval.3,v
retrieving revision 1.11
diff -u -r1.11 Eval.3
--- doc/Eval.3 1 Jul 2002 18:24:39 -0000 1.11
+++ doc/Eval.3 25 Jul 2002 01:29:58 -0000
@@ -66,10 +66,8 @@
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
Index: doc/ExprLong.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/ExprLong.3,v
retrieving revision 1.5
diff -u -r1.5 ExprLong.3
--- doc/ExprLong.3 10 Dec 2001 15:50:46 -0000 1.5
+++ doc/ExprLong.3 25 Jul 2002 01:29:58 -0000
@@ -34,9 +34,7 @@
.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.
Index: doc/LinkVar.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/LinkVar.3,v
retrieving revision 1.5
diff -u -r1.5 LinkVar.3
--- doc/LinkVar.3 26 Feb 2002 02:22:20 -0000 1.5
+++ doc/LinkVar.3 25 Jul 2002 01:29:58 -0000
@@ -27,9 +27,8 @@
.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
Index: doc/ParseCmd.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/ParseCmd.3,v
retrieving revision 1.9
diff -u -r1.9 ParseCmd.3
--- doc/ParseCmd.3 1 Jul 2002 18:24:39 -0000 1.9
+++ doc/ParseCmd.3 25 Jul 2002 01:29:58 -0000
@@ -49,7 +49,7 @@
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 @@
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
Index: doc/SetVar.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/SetVar.3,v
retrieving revision 1.6
diff -u -r1.6 SetVar.3
--- doc/SetVar.3 29 Mar 2002 02:39:27 -0000 1.6
+++ doc/SetVar.3 25 Jul 2002 01:29:58 -0000
@@ -53,7 +53,7 @@
.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 @@
.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.
Index: doc/TraceVar.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/TraceVar.3,v
retrieving revision 1.7
diff -u -r1.7 TraceVar.3
--- doc/TraceVar.3 29 Mar 2002 02:39:27 -0000 1.7
+++ doc/TraceVar.3 25 Jul 2002 01:29:58 -0000
@@ -35,13 +35,10 @@
.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 @@
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
Index: doc/UpVar.3
===================================================================
RCS file: /cvsroot/tcl/tcl/doc/UpVar.3,v
retrieving revision 1.6
diff -u -r1.6 UpVar.3
--- doc/UpVar.3 29 Mar 2002 02:39:27 -0000 1.6
+++ doc/UpVar.3 25 Jul 2002 01:29:58 -0000
@@ -29,7 +29,7 @@
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 @@
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
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.91
diff -u -r1.91 tcl.decls
--- generic/tcl.decls 22 Jul 2002 16:51:47 -0000 1.91
+++ generic/tcl.decls 25 Jul 2002 01:29:58 -0000
@@ -32,7 +32,7 @@
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 @@
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 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 @@
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 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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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)
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.136
diff -u -r1.136 tcl.h
--- generic/tcl.h 22 Jul 2002 16:51:47 -0000 1.136
+++ generic/tcl.h 25 Jul 2002 01:29:58 -0000
@@ -249,9 +249,19 @@
#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_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 @@
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));
@@ -1582,7 +1592,7 @@
_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));
@@ -1609,7 +1619,7 @@
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,
@@ -1933,7 +1943,7 @@
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
@@ -2047,14 +2057,14 @@
#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,
@@ -2078,13 +2088,13 @@
* 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
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.65
diff -u -r1.65 tclBasic.c
--- generic/tclBasic.c 19 Jul 2002 12:31:09 -0000 1.65
+++ generic/tclBasic.c 25 Jul 2002 01:29:59 -0000
@@ -1753,8 +1753,8 @@
*/
#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 @@
*/
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 @@
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 @@
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
@@ -3302,7 +3302,7 @@
#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;
/*
@@ -3510,7 +3510,7 @@
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. */
@@ -3520,7 +3520,7 @@
* 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;
@@ -3535,7 +3535,7 @@
* 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
@@ -3706,7 +3706,7 @@
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
@@ -3785,11 +3785,9 @@
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
@@ -4295,7 +4293,7 @@
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
@@ -4392,7 +4390,7 @@
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
@@ -4925,7 +4923,7 @@
( data->proc )( data->clientData, interp, level,
(char*) command, cmdPtr->proc, cmdPtr->clientData,
- objc, (char**) argv );
+ objc, argv );
ckfree( (char*) argv );
return TCL_OK;
@@ -5232,7 +5230,7 @@
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;
Index: generic/tclCmdMZ.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCmdMZ.c,v
retrieving revision 1.73
diff -u -r1.73 tclCmdMZ.c
--- generic/tclCmdMZ.c 19 Jun 2002 22:38:39 -0000 1.73
+++ generic/tclCmdMZ.c 25 Jul 2002 01:29:59 -0000
@@ -113,11 +113,11 @@
*/
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 @@
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 @@
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 @@
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 @@
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
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.31
diff -u -r1.31 tclCompCmds.c
--- generic/tclCompCmds.c 3 Jul 2002 17:33:39 -0000 1.31
+++ generic/tclCompCmds.c 25 Jul 2002 01:29:59 -0000
@@ -123,8 +123,8 @@
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 @@
{
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 @@
}
}
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 @@
*/
envPtr->currStackDepth = savedStackDepth;
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
code = TCL_OK;
done:
@@ -697,7 +696,7 @@
* Instructions are added to envPtr to execute the "foreach" command
* at runtime.
*
- *----------------------------------------------------------------------
+n*----------------------------------------------------------------------
*/
int
@@ -716,16 +715,13 @@
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 @@
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 @@
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 @@
*/
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 @@
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 @@
* 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 @@
*/
if (compileScripts) {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,/*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
}
@@ -1546,9 +1527,9 @@
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 @@
* 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 @@
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 @@
* always creates the variable.
*/
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
numValues = 1;
#endif
}
@@ -1826,11 +1809,9 @@
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 @@
* 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 @@
+ (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 @@
* 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 @@
/* 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 @@
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 @@
/*
* 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 @@
} 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 @@
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 @@
*/
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 @@
* 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 @@
* [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 @@
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 @@
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 @@
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 @@
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 @@
}
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 @@
* 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 @@
{
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 @@
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 @@
* 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 @@
* 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 @@
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 @@
{
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 @@
}
}
if (localIndex < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, name, nameChars,
- /*onHeap*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameChars), envPtr);
}
/*
@@ -3285,13 +3250,11 @@
/*
* 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 @@
goto done;
}
} else {
- TclEmitPush(TclRegisterLiteral(envPtr, "", 0,
- /*alreadyAlloced*/ 0), envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr);
}
}
} else {
@@ -3327,6 +3289,7 @@
if (gotElemParse) {
Tcl_FreeParse(&elemParse);
}
+ Tcl_DStringFree(©);
*localIndexPtr = localIndex;
*simpleVarNamePtr = simpleVarName;
*isScalarPtr = (elName == NULL);
Index: generic/tclCompExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompExpr.c,v
retrieving revision 1.11
diff -u -r1.11 tclCompExpr.c
--- generic/tclCompExpr.c 19 Jul 2002 12:31:09 -0000 1.11
+++ generic/tclCompExpr.c 25 Jul 2002 01:29:59 -0000
@@ -51,9 +51,9 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
*/
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 @@
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 @@
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 @@
*/
if (mathFuncPtr->builtinFuncIndex < 0) {
- TclEmitPush(TclRegisterLiteral(envPtr, funcName, -1, /*onHeap*/ 0),
- envPtr);
+ TclEmitPush(TclRegisterNewLiteral(envPtr, funcName, -1), envPtr);
}
/*
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.39
diff -u -r1.39 tclCompile.c
--- generic/tclCompile.c 19 Jul 2002 12:31:09 -0000 1.39
+++ generic/tclCompile.c 25 Jul 2002 01:29:59 -0000
@@ -292,7 +292,8 @@
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 @@
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 @@
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 @@
* 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 @@
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 @@
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 @@
{
Tcl_Token *wordPtr;
int range, numBytes, i, code;
- char *script;
+ CONST char *script;
range = -1;
code = TCL_OK;
@@ -1639,15 +1638,15 @@
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;
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.29
diff -u -r1.29 tclCompile.h
--- generic/tclCompile.h 19 Jul 2002 12:31:09 -0000 1.29
+++ generic/tclCompile.h 25 Jul 2002 01:29:59 -0000
@@ -724,7 +724,7 @@
*/
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 @@
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,
@@ -834,6 +834,15 @@
* inside the Tcl core but not used outside.
*----------------------------------------------------------------
*/
+
+/*
+ * 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.
Index: generic/tclEnv.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEnv.c,v
retrieving revision 1.15
diff -u -r1.15 tclEnv.c
--- generic/tclEnv.c 6 Jun 2002 17:37:55 -0000 1.15
+++ generic/tclEnv.c 25 Jul 2002 01:29:59 -0000
@@ -46,8 +46,8 @@
*/
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 @@
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. */
Index: generic/tclEvent.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclEvent.c,v
retrieving revision 1.22
diff -u -r1.22 tclEvent.c
--- generic/tclEvent.c 14 May 2002 09:44:43 -0000 1.22
+++ generic/tclEvent.c 25 Jul 2002 01:30:00 -0000
@@ -111,8 +111,8 @@
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 @@
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 @@
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. */
{
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.53
diff -u -r1.53 tclInt.decls
--- generic/tclInt.decls 17 Jul 2002 18:21:54 -0000 1.53
+++ generic/tclInt.decls 25 Jul 2002 01:30:00 -0000
@@ -183,7 +183,7 @@
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 @@
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 @@
# 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 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 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 @@
# 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 @@
}
# 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 @@
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 @@
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[])
}
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.108
diff -u -r1.108 tclInt.h
--- generic/tclInt.h 22 Jul 2002 16:51:48 -0000 1.108
+++ generic/tclInt.h 25 Jul 2002 01:30:00 -0000
@@ -1594,10 +1594,8 @@
*----------------------------------------------------------------
*/
-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 @@
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 @@
#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 @@
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));
/*
Index: generic/tclInterp.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInterp.c,v
retrieving revision 1.12
diff -u -r1.12 tclInterp.c
--- generic/tclInterp.c 7 Mar 2002 20:17:22 -0000 1.12
+++ generic/tclInterp.c 25 Jul 2002 01:30:00 -0000
@@ -831,7 +831,7 @@
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;
@@ -929,7 +929,7 @@
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;
@@ -957,7 +957,8 @@
*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]);
}
Index: generic/tclLink.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclLink.c,v
retrieving revision 1.7
diff -u -r1.7 tclLink.c
--- generic/tclLink.c 20 Mar 2002 22:47:36 -0000 1.7
+++ generic/tclLink.c 25 Jul 2002 01:30:00 -0000
@@ -60,8 +60,8 @@
*/
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 @@
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 @@
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 @@
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 @@
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. */
{
Index: generic/tclObj.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclObj.c,v
retrieving revision 1.33
diff -u -r1.33 tclObj.c
--- generic/tclObj.c 26 Apr 2002 08:34:35 -0000 1.33
+++ generic/tclObj.c 25 Jul 2002 01:30:00 -0000
@@ -1209,7 +1209,7 @@
* 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.
*/
Index: generic/tclParse.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParse.c,v
retrieving revision 1.21
diff -u -r1.21 tclParse.c
--- generic/tclParse.c 19 Jul 2002 10:12:28 -0000 1.21
+++ generic/tclParse.c 25 Jul 2002 01:30:00 -0000
@@ -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.20 2002/04/12 06:28:33 hobbs 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 @@
* 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_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 @@
* 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 @@
}
/*
- * 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 @@
* 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 @@
src++;
break;
}
- if (src == parsePtr->end) {
- break;
- }
tokenPtr->start = src;
parsePtr->numTokens++;
parsePtr->numWords++;
@@ -386,28 +324,28 @@
*/
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 @@
* 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 @@
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 @@
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 @@
*/
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 @@
* 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 @@
*/
originalTokens = parsePtr->numTokens;
- while (1) {
+ while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) {
if (parsePtr->numTokens == parsePtr->tokensAvailable) {
TclExpandTokenArray(parsePtr);
}
@@ -553,22 +815,15 @@
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 @@
*/
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 @@
* 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 @@
/*
* 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 @@
*/
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 @@
* 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 @@
parsePtr->term = src;
return TCL_OK;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -708,7 +975,7 @@
parsePtr->tokenPtr = parsePtr->staticTokens;
}
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -746,14 +1013,15 @@
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_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 @@
* 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 @@
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 @@
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 @@
*/
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 @@
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 @@
/*
* 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 @@
* 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_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -986,9 +1260,9 @@
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_ResetResult(interp);
return TclGetString(objPtr);
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1043,7 +1317,8 @@
*
* 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_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 @@
* 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 @@
}
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 @@
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_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 @@
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 @@
*
* 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_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 @@
* 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_FreeParse(parsePtr);
return TCL_ERROR;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1353,16 +1633,16 @@
*/
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 @@
Tcl_FreeParse(&parse);
return result;
}
-
+
/*
*----------------------------------------------------------------------
*
@@ -1402,11 +1682,11 @@
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 @@
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);
}
-
+
/*
*----------------------------------------------------------------------
*
Index: generic/tclParseExpr.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclParseExpr.c,v
retrieving revision 1.14
diff -u -r1.14 tclParseExpr.c
--- generic/tclParseExpr.c 22 Jul 2002 10:04:17 -0000 1.14
+++ generic/tclParseExpr.c 25 Jul 2002 01:30:00 -0000
@@ -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.13 2002/06/21 21:17:39 jenglish Exp $
*/
#include "tclInt.h"
@@ -55,16 +56,16 @@
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 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 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 @@
* 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 @@
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 @@
{
ParseInfo info;
int code;
- char savedChar;
if (numBytes < 0) {
numBytes = (string? strlen(string) : 0);
@@ -250,17 +253,6 @@
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 @@
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 @@
* 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 @@
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
{
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 @@
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 @@
* 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 @@
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 @@
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 @@
* 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 @@
}
/*
- * 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 @@
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 @@
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 @@
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 @@
}
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 @@
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 @@
/*
*----------------------------------------------------------------------
*
+ * 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 @@
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 @@
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 @@
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),
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.39
diff -u -r1.39 tclProc.c
--- generic/tclProc.c 16 Jul 2002 01:12:50 -0000 1.39
+++ generic/tclProc.c 25 Jul 2002 01:30:00 -0000
@@ -798,7 +798,7 @@
* 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;
Index: generic/tclTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclTest.c,v
retrieving revision 1.55
diff -u -r1.55 tclTest.c
--- generic/tclTest.c 22 Jul 2002 16:57:47 -0000 1.55
+++ generic/tclTest.c 25 Jul 2002 01:30:01 -0000
@@ -17,7 +17,6 @@
*/
#define TCL_TEST
-
#include "tclInt.h"
#include "tclPort.h"
@@ -124,9 +123,9 @@
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 @@
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 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 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 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 @@
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 @@
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 @@
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 @@
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 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 @@
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 @@
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 @@
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 @@
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 @@
* checking is needed here.
*/
}
- ckfree(cmd);
+ ckfree((char *)cmd);
return code;
}
@@ -803,7 +803,7 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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;
Index: generic/tclUtf.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtf.c,v
retrieving revision 1.27
diff -u -r1.27 tclUtf.c
--- generic/tclUtf.c 19 Jul 2002 12:31:10 -0000 1.27
+++ generic/tclUtf.c 25 Jul 2002 01:30:01 -0000
@@ -778,129 +778,19 @@
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];
+#define LINE_LENGTH 128
+ int numRead;
+ int result;
- if (dst == NULL) {
- dst = buf;
+ 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;
}
/*
Index: generic/tclUtil.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclUtil.c,v
retrieving revision 1.32
diff -u -r1.32 tclUtil.c
--- generic/tclUtil.c 25 Jun 2002 08:59:36 -0000 1.32
+++ generic/tclUtil.c 25 Jul 2002 01:30:01 -0000
@@ -947,7 +947,7 @@
*----------------------------------------------------------------------
*/
-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 @@
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 @@
* 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;
- }
- if ((*p != '.') && (*p != 'e') && (*p != 'E')) {
- return 1;
+ p++; length--;
}
- return 0;
+
+ return (0 != TclParseInteger(p, length));
}
/*
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.60
diff -u -r1.60 tclVar.c
--- generic/tclVar.c 17 Jul 2002 20:42:27 -0000 1.60
+++ generic/tclVar.c 25 Jul 2002 01:30:02 -0000
@@ -43,13 +43,13 @@
*/
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 @@
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 @@
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,29 +235,35 @@
elName = part2;
for (p = part1; *p ; p++) {
if (*p == '(') {
- openParen = p;
+ openParen = p - part1;
do {
p++;
} while (*p != '\0');
p--;
if (*p == ')') {
if (part2 != NULL) {
- openParen = NULL;
if (flags & TCL_LEAVE_ERR_MSG) {
VarErrMsg(interp, part1, part2, msg, needArray);
}
- goto done;
+ 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);
@@ -263,7 +271,7 @@
if ((errMsg != NULL) && (flags & TCL_LEAVE_ERR_MSG)) {
VarErrMsg(interp, part1, elName, msg, errMsg);
}
- return NULL;
+ goto done;
}
while (TclIsVarLink(varPtr)) {
@@ -276,12 +284,14 @@
varPtr = TclLookupArrayElement(interp, part1, elName, flags,
msg, createPart1, createPart2, varPtr);
- done:
- if (openParen != NULL) {
- *openParen = '(';
- *closeParen = ')';
+ done:
+ if (newVarName != buffer) {
+ ckfree(newVarName);
}
+
return varPtr;
+
+#undef VAR_NAME_BUF_SIZE
}
/*
@@ -966,7 +976,7 @@
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. */
@@ -1001,7 +1011,7 @@
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. */
@@ -1045,7 +1055,7 @@
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. */
@@ -1156,7 +1166,7 @@
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. */
@@ -1288,7 +1298,7 @@
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,
@@ -1329,7 +1339,7 @@
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
@@ -1402,7 +1412,7 @@
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. */
@@ -1513,7 +1523,7 @@
* 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. */
@@ -1769,7 +1779,7 @@
* 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
@@ -1874,7 +1884,7 @@
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
@@ -1909,7 +1919,7 @@
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,
@@ -2121,7 +2131,7 @@
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,
@@ -2160,7 +2170,7 @@
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. */
@@ -2238,7 +2248,7 @@
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
@@ -2272,7 +2282,7 @@
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. */
@@ -2383,7 +2393,7 @@
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). */
@@ -2418,7 +2428,7 @@
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. */
@@ -3578,7 +3588,7 @@
* 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. */
@@ -3615,7 +3625,7 @@
* 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. */
@@ -4055,7 +4065,7 @@
* 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,
@@ -4068,7 +4078,8 @@
{
register VarTrace *tracePtr;
ActiveVarTrace active;
- char *result, *openParen, *p;
+ char *result;
+ CONST char *openParen, *p;
Tcl_DString nameCopy;
int copiedName;
int code = TCL_OK;
@@ -4108,11 +4119,13 @@
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;
@@ -4724,7 +4737,7 @@
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:
@@ -4883,7 +4896,7 @@
Var *
TclVarTraceExists(interp, varName)
Tcl_Interp *interp; /* The interpreter */
- char *varName; /* The variable name */
+ CONST char *varName; /* The variable name */
{
Var *varPtr;
Var *arrayPtr;
Index: mac/tclMacTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacTest.c,v
retrieving revision 1.4
diff -u -r1.4 tclMacTest.c
--- mac/tclMacTest.c 11 May 1999 07:13:36 -0000 1.4
+++ mac/tclMacTest.c 25 Jul 2002 01:30:02 -0000
@@ -13,7 +13,7 @@
*/
#define TCL_TEST
-
+#define USE_COMPAT_CONST
#include "tclInt.h"
#include "tclMacInt.h"
#include "tclMacPort.h"
Index: tests/expr.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/expr.test,v
retrieving revision 1.16
diff -u -r1.16 expr.test
--- tests/expr.test 22 Jul 2002 10:04:17 -0000 1.16
+++ tests/expr.test 25 Jul 2002 01:30:02 -0000
@@ -799,7 +799,7 @@
test expr-22.7 {non-numeric floats} {
list [catch {expr {1 / NaN}} msg] $msg
} {1 {domain error: argument not in valid range}}
-test expr-22.8 {non-numeric floats} knownBug {
+test expr-22.8 {non-numeric floats} {
list [catch {expr {1 / Inf}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "/"}}
Index: unix/tclUnixTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixTest.c,v
retrieving revision 1.11
diff -u -r1.11 tclUnixTest.c
--- unix/tclUnixTest.c 13 Oct 1999 00:32:50 -0000 1.11
+++ unix/tclUnixTest.c 25 Jul 2002 01:30:02 -0000
@@ -66,22 +66,22 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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";
Index: unix/tclXtTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclXtTest.c,v
retrieving revision 1.4
diff -u -r1.4 tclXtTest.c
--- unix/tclXtTest.c 2 Jul 1999 06:05:34 -0000 1.4
+++ unix/tclXtTest.c 25 Jul 2002 01:30:02 -0000
@@ -15,7 +15,7 @@
#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 @@
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"
Index: win/tclWinTest.c
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinTest.c,v
retrieving revision 1.6
diff -u -r1.6 tclWinTest.c
--- win/tclWinTest.c 21 Nov 2001 02:36:21 -0000 1.6
+++ win/tclWinTest.c 25 Jul 2002 01:30:02 -0000
@@ -11,6 +11,7 @@
* RCS: @(#) $Id: tclWinTest.c,v 1.6 2001/11/21 02:36:21 hobbs Exp $
*/
+#define USE_COMPAT_CONST
#include "tclWinInt.h"
/*
