Tcl Source Code

Check-in [e46c7b8b77]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:TIP #485 implementation: "Remove Deprecated API". Based on Tcl 8.7 (core-8-branch).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-485
Files: files | file ages | folders
SHA3-256: e46c7b8b77d353647c8b720c4a8fcaa0436635233b52c22ff8f7a817f26a6ca9
User & Date: jan.nijtmans 2017-11-08 11:50:55
Context
2017-11-09
10:34
Put Tcl_EvalFile back, but then as a macro in terms of Tcl_FSEvalFileEx(). check-in: 9f1544d005 user: jan.nijtmans tags: tip-485
2017-11-08
11:50
TIP #485 implementation: "Remove Deprecated API". Based on Tcl 8.7 (core-8-branch). check-in: e46c7b8b77 user: jan.nijtmans tags: tip-485
09:37
Change "epoch" field for dicts from "int" to "unsigned int". This doubles the number of available ep... check-in: c9da2e2ebb user: jan.nijtmans tags: core-8-branch
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.decls.

281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
...
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
....
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
....
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
....
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
}
declare 75 {
    int Tcl_AsyncReady(void)
}
declare 76 {
    void Tcl_BackgroundError(Tcl_Interp *interp)
}
declare 77 {
    char Tcl_Backslash(const char *src, int *readPtr)
}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
................................................................................
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
declare 95 {
    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
	    int numArgs, Tcl_ValueType *argTypes,
	    Tcl_MathProc *proc, ClientData clientData)
}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
................................................................................
declare 128 {
    CONST84_RETURN char *Tcl_ErrnoMsg(int err)
}
declare 129 {
    int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
# This is obsolete, use Tcl_FSEvalFile
declare 130 {
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
declare 131 {
    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 132 {
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
................................................................................
}
declare 339 {
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 {
    CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
}
declare 342 {
    void Tcl_SetDefaultEncodingDir(const char *path)
}
declare 343 {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
................................................................................
    Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
declare 357 {
    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    int count)
}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
................................................................................

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
declare 435 {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 {
    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}

# TIP#36 (better access to 'subst') dkf
declare 437 {
    Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}






|







 







|







 







|







 







|


|







 







|







 







|




|







281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
...
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
....
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
....
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
....
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
}
declare 75 {
    int Tcl_AsyncReady(void)
}
declare 76 {
    void Tcl_BackgroundError(Tcl_Interp *interp)
}
declare 77 {deprecated {Use Tcl_UtfBackslash}} {
    char Tcl_Backslash(const char *src, int *readPtr)
}
declare 78 {
    int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName,
	    const char *optionList)
}
declare 79 {
................................................................................
}
declare 93 {
    void Tcl_CreateExitHandler(Tcl_ExitProc *proc, ClientData clientData)
}
declare 94 {
    Tcl_Interp *Tcl_CreateInterp(void)
}
declare 95 {deprecated {}} {
    void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name,
	    int numArgs, Tcl_ValueType *argTypes,
	    Tcl_MathProc *proc, ClientData clientData)
}
declare 96 {
    Tcl_Command Tcl_CreateObjCommand(Tcl_Interp *interp,
	    const char *cmdName,
................................................................................
declare 128 {
    CONST84_RETURN char *Tcl_ErrnoMsg(int err)
}
declare 129 {
    int Tcl_Eval(Tcl_Interp *interp, const char *script)
}
# This is obsolete, use Tcl_FSEvalFile
declare 130 {deprecated {Use Tcl_FSEvalFile}} {
    int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName)
}
declare 131 {
    int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr)
}
declare 132 {
    void Tcl_EventuallyFree(ClientData clientData, Tcl_FreeProc *freeProc)
................................................................................
}
declare 339 {
    int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr)
}
declare 340 {
    char *Tcl_GetString(Tcl_Obj *objPtr)
}
declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} {
    CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void)
}
declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} {
    void Tcl_SetDefaultEncodingDir(const char *path)
}
declare 343 {
    void Tcl_AlertNotifier(ClientData clientData)
}
declare 344 {
    void Tcl_ServiceModeHook(int mode)
................................................................................
    Tcl_UniChar *Tcl_UtfToUniCharDString(const char *src,
	    int length, Tcl_DString *dsPtr)
}
declare 356 {
    Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj,
	    int flags)
}
declare 357 {deprecated {Use Tcl_EvalTokensStandard}} {
    Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr,
	    int count)
}
declare 358 {
    void Tcl_FreeParse(Tcl_Parse *parsePtr)
}
declare 359 {
................................................................................

# introduced in 8.4a3
declare 434 {
    Tcl_UniChar *Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr)
}

# TIP#15 (math function introspection) dkf
declare 435 {deprecated {}} {
    int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name,
	    int *numArgsPtr, Tcl_ValueType **argTypesPtr,
	    Tcl_MathProc **procPtr, ClientData *clientDataPtr)
}
declare 436 {deprecated {}} {
    Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern)
}

# TIP#36 (better access to 'subst') dkf
declare 437 {
    Tcl_Obj *Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, int flags)
}

Changes to generic/tclBasic.c.

199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
    /*
     * Commands in the generic core.
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
#ifndef TCL_NO_DEPRECATED
    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
#endif
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},






|







199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
    /*
     * Commands in the generic core.
     */

    {"append",		Tcl_AppendObjCmd,	TclCompileAppendCmd,	NULL,	CMD_IS_SAFE},
    {"apply",		Tcl_ApplyObjCmd,	NULL,			TclNRApplyObjCmd,	CMD_IS_SAFE},
    {"break",		Tcl_BreakObjCmd,	TclCompileBreakCmd,	NULL,	CMD_IS_SAFE},
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    {"case",		Tcl_CaseObjCmd,		NULL,			NULL,	CMD_IS_SAFE},
#endif
    {"catch",		Tcl_CatchObjCmd,	TclCompileCatchCmd,	TclNRCatchObjCmd,	CMD_IS_SAFE},
    {"concat",		Tcl_ConcatObjCmd,	TclCompileConcatCmd,	NULL,	CMD_IS_SAFE},
    {"continue",	Tcl_ContinueObjCmd,	TclCompileContinueCmd,	NULL,	CMD_IS_SAFE},
    {"coroutine",	NULL,			NULL,			TclNRCoroutineObjCmd,	CMD_IS_SAFE},
    {"error",		Tcl_ErrorObjCmd,	TclCompileErrorCmd,	NULL,	CMD_IS_SAFE},

Changes to generic/tclCmdAH.c.

160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
#ifndef TCL_NO_DEPRECATED
	/* ARGSUSED */
int
Tcl_CaseObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */






|







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
 *	A standard Tcl object result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	/* ARGSUSED */
int
Tcl_CaseObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */

Changes to generic/tclDecls.h.

259
260
261
262
263
264
265

266
267
268
269
270
271
272
273
...
318
319
320
321
322
323
324

325
326
327
328
329
330
331
332
...
414
415
416
417
418
419
420

421
422
423
424
425
426
427
428
....
1006
1007
1008
1009
1010
1011
1012

1013
1014

1015
1016
1017
1018
1019
1020
1021
1022
....
1043
1044
1045
1046
1047
1048
1049

1050
1051
1052
1053
1054
1055
1056
1057
....
1264
1265
1266
1267
1268
1269
1270

1271
1272
1273
1274
1275
1276

1277
1278
1279
1280
1281
1282
1283
1284
....
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
....
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
....
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
....
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
....
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
....
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
/* 74 */
EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
EXTERN int		Tcl_AsyncReady(void);
/* 76 */
EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */

EXTERN char		Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
................................................................................
				ClientData clientData);
/* 93 */
EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 94 */
EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
/* 95 */

EXTERN void		Tcl_CreateMathFunc(Tcl_Interp *interp,
				const char *name, int numArgs,
				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
				ClientData clientData);
/* 96 */
EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				ClientData clientData,
................................................................................
/* 127 */
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
/* 128 */
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
/* 129 */
EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */

EXTERN int		Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* 131 */
EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* 132 */
EXTERN void		Tcl_EventuallyFree(ClientData clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
................................................................................
EXTERN int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				int srcLen);
/* 339 */
EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */

EXTERN CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void);
/* 342 */

EXTERN void		Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
EXTERN void		Tcl_AlertNotifier(ClientData clientData);
/* 344 */
EXTERN void		Tcl_ServiceModeHook(int mode);
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
................................................................................
/* 355 */
EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src, int length,
				Tcl_DString *dsPtr);
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* 357 */

EXTERN Tcl_Obj *	Tcl_EvalTokens(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
/* 358 */
EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				int length);
................................................................................
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 435 */

EXTERN int		Tcl_GetMathFuncInfo(Tcl_Interp *interp,
				const char *name, int *numArgsPtr,
				Tcl_ValueType **argTypesPtr,
				Tcl_MathProc **procPtr,
				ClientData *clientDataPtr);
/* 436 */

EXTERN Tcl_Obj *	Tcl_ListMathFuncs(Tcl_Interp *interp,
				const char *pattern);
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
				Tcl_Channel channel);
................................................................................
    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
    int (*tcl_AsyncReady) (void); /* 75 */
    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
    int (*tcl_CommandComplete) (const char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
    int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
................................................................................
    Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
................................................................................
    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
    CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
    CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
    int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
    int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
    TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
................................................................................
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
    int (*tcl_UtfToUpper) (char *src); /* 337 */
    int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
    void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
    void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
................................................................................
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
    int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
    char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
................................................................................
    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
    char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
    int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
    int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */






>
|







 







>
|







 







>
|







 







>
|

>
|







 







>
|







 







>
|





>
|







 







|







 







|







 







|







 







|
|







 







|







 







|
|







259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
...
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
...
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
....
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
....
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
....
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
....
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
....
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
....
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
....
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
....
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
....
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
/* 74 */
EXTERN void		Tcl_AsyncMark(Tcl_AsyncHandler async);
/* 75 */
EXTERN int		Tcl_AsyncReady(void);
/* 76 */
EXTERN void		Tcl_BackgroundError(Tcl_Interp *interp);
/* 77 */
TCL_DEPRECATED("Use Tcl_UtfBackslash")
char			Tcl_Backslash(const char *src, int *readPtr);
/* 78 */
EXTERN int		Tcl_BadChannelOption(Tcl_Interp *interp,
				const char *optionName,
				const char *optionList);
/* 79 */
EXTERN void		Tcl_CallWhenDeleted(Tcl_Interp *interp,
				Tcl_InterpDeleteProc *proc,
................................................................................
				ClientData clientData);
/* 93 */
EXTERN void		Tcl_CreateExitHandler(Tcl_ExitProc *proc,
				ClientData clientData);
/* 94 */
EXTERN Tcl_Interp *	Tcl_CreateInterp(void);
/* 95 */
TCL_DEPRECATED("")
void			Tcl_CreateMathFunc(Tcl_Interp *interp,
				const char *name, int numArgs,
				Tcl_ValueType *argTypes, Tcl_MathProc *proc,
				ClientData clientData);
/* 96 */
EXTERN Tcl_Command	Tcl_CreateObjCommand(Tcl_Interp *interp,
				const char *cmdName, Tcl_ObjCmdProc *proc,
				ClientData clientData,
................................................................................
/* 127 */
EXTERN CONST84_RETURN char * Tcl_ErrnoId(void);
/* 128 */
EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err);
/* 129 */
EXTERN int		Tcl_Eval(Tcl_Interp *interp, const char *script);
/* 130 */
TCL_DEPRECATED("Use Tcl_FSEvalFile")
int			Tcl_EvalFile(Tcl_Interp *interp,
				const char *fileName);
/* 131 */
EXTERN int		Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr);
/* 132 */
EXTERN void		Tcl_EventuallyFree(ClientData clientData,
				Tcl_FreeProc *freeProc);
/* 133 */
................................................................................
EXTERN int		Tcl_WriteChars(Tcl_Channel chan, const char *src,
				int srcLen);
/* 339 */
EXTERN int		Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr);
/* 340 */
EXTERN char *		Tcl_GetString(Tcl_Obj *objPtr);
/* 341 */
TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath")
CONST84_RETURN char *	Tcl_GetDefaultEncodingDir(void);
/* 342 */
TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath")
void			Tcl_SetDefaultEncodingDir(const char *path);
/* 343 */
EXTERN void		Tcl_AlertNotifier(ClientData clientData);
/* 344 */
EXTERN void		Tcl_ServiceModeHook(int mode);
/* 345 */
EXTERN int		Tcl_UniCharIsAlnum(int ch);
/* 346 */
................................................................................
/* 355 */
EXTERN Tcl_UniChar *	Tcl_UtfToUniCharDString(const char *src, int length,
				Tcl_DString *dsPtr);
/* 356 */
EXTERN Tcl_RegExp	Tcl_GetRegExpFromObj(Tcl_Interp *interp,
				Tcl_Obj *patObj, int flags);
/* 357 */
TCL_DEPRECATED("Use Tcl_EvalTokensStandard")
Tcl_Obj *		Tcl_EvalTokens(Tcl_Interp *interp,
				Tcl_Token *tokenPtr, int count);
/* 358 */
EXTERN void		Tcl_FreeParse(Tcl_Parse *parsePtr);
/* 359 */
EXTERN void		Tcl_LogCommandInfo(Tcl_Interp *interp,
				const char *script, const char *command,
				int length);
................................................................................
EXTERN int		Tcl_AttemptSetObjLength(Tcl_Obj *objPtr, int length);
/* 433 */
EXTERN Tcl_ThreadId	Tcl_GetChannelThread(Tcl_Channel channel);
/* 434 */
EXTERN Tcl_UniChar *	Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr,
				int *lengthPtr);
/* 435 */
TCL_DEPRECATED("")
int			Tcl_GetMathFuncInfo(Tcl_Interp *interp,
				const char *name, int *numArgsPtr,
				Tcl_ValueType **argTypesPtr,
				Tcl_MathProc **procPtr,
				ClientData *clientDataPtr);
/* 436 */
TCL_DEPRECATED("")
Tcl_Obj *		Tcl_ListMathFuncs(Tcl_Interp *interp,
				const char *pattern);
/* 437 */
EXTERN Tcl_Obj *	Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 438 */
EXTERN int		Tcl_DetachChannel(Tcl_Interp *interp,
				Tcl_Channel channel);
................................................................................
    void (*tcl_AppendResult) (Tcl_Interp *interp, ...); /* 70 */
    Tcl_AsyncHandler (*tcl_AsyncCreate) (Tcl_AsyncProc *proc, ClientData clientData); /* 71 */
    void (*tcl_AsyncDelete) (Tcl_AsyncHandler async); /* 72 */
    int (*tcl_AsyncInvoke) (Tcl_Interp *interp, int code); /* 73 */
    void (*tcl_AsyncMark) (Tcl_AsyncHandler async); /* 74 */
    int (*tcl_AsyncReady) (void); /* 75 */
    void (*tcl_BackgroundError) (Tcl_Interp *interp); /* 76 */
    TCL_DEPRECATED_API("Use Tcl_UtfBackslash") char (*tcl_Backslash) (const char *src, int *readPtr); /* 77 */
    int (*tcl_BadChannelOption) (Tcl_Interp *interp, const char *optionName, const char *optionList); /* 78 */
    void (*tcl_CallWhenDeleted) (Tcl_Interp *interp, Tcl_InterpDeleteProc *proc, ClientData clientData); /* 79 */
    void (*tcl_CancelIdleCall) (Tcl_IdleProc *idleProc, ClientData clientData); /* 80 */
    int (*tcl_Close) (Tcl_Interp *interp, Tcl_Channel chan); /* 81 */
    int (*tcl_CommandComplete) (const char *cmd); /* 82 */
    char * (*tcl_Concat) (int argc, CONST84 char *const *argv); /* 83 */
    int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */
................................................................................
    Tcl_Channel (*tcl_CreateChannel) (const Tcl_ChannelType *typePtr, const char *chanName, ClientData instanceData, int mask); /* 88 */
    void (*tcl_CreateChannelHandler) (Tcl_Channel chan, int mask, Tcl_ChannelProc *proc, ClientData clientData); /* 89 */
    void (*tcl_CreateCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 90 */
    Tcl_Command (*tcl_CreateCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 91 */
    void (*tcl_CreateEventSource) (Tcl_EventSetupProc *setupProc, Tcl_EventCheckProc *checkProc, ClientData clientData); /* 92 */
    void (*tcl_CreateExitHandler) (Tcl_ExitProc *proc, ClientData clientData); /* 93 */
    Tcl_Interp * (*tcl_CreateInterp) (void); /* 94 */
    TCL_DEPRECATED_API("") void (*tcl_CreateMathFunc) (Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); /* 95 */
    Tcl_Command (*tcl_CreateObjCommand) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc *proc, ClientData clientData, Tcl_CmdDeleteProc *deleteProc); /* 96 */
    Tcl_Interp * (*tcl_CreateSlave) (Tcl_Interp *interp, const char *slaveName, int isSafe); /* 97 */
    Tcl_TimerToken (*tcl_CreateTimerHandler) (int milliseconds, Tcl_TimerProc *proc, ClientData clientData); /* 98 */
    Tcl_Trace (*tcl_CreateTrace) (Tcl_Interp *interp, int level, Tcl_CmdTraceProc *proc, ClientData clientData); /* 99 */
    void (*tcl_DeleteAssocData) (Tcl_Interp *interp, const char *name); /* 100 */
    void (*tcl_DeleteChannelHandler) (Tcl_Channel chan, Tcl_ChannelProc *proc, ClientData clientData); /* 101 */
    void (*tcl_DeleteCloseHandler) (Tcl_Channel chan, Tcl_CloseProc *proc, ClientData clientData); /* 102 */
................................................................................
    void (*tcl_DStringResult) (Tcl_Interp *interp, Tcl_DString *dsPtr); /* 123 */
    void (*tcl_DStringSetLength) (Tcl_DString *dsPtr, int length); /* 124 */
    void (*tcl_DStringStartSublist) (Tcl_DString *dsPtr); /* 125 */
    int (*tcl_Eof) (Tcl_Channel chan); /* 126 */
    CONST84_RETURN char * (*tcl_ErrnoId) (void); /* 127 */
    CONST84_RETURN char * (*tcl_ErrnoMsg) (int err); /* 128 */
    int (*tcl_Eval) (Tcl_Interp *interp, const char *script); /* 129 */
    TCL_DEPRECATED_API("Use Tcl_FSEvalFile") int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */
    int (*tcl_EvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 131 */
    void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */
    TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */
    int (*tcl_ExposeCommand) (Tcl_Interp *interp, const char *hiddenCmdToken, const char *cmdName); /* 134 */
    int (*tcl_ExprBoolean) (Tcl_Interp *interp, const char *expr, int *ptr); /* 135 */
    int (*tcl_ExprBooleanObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *ptr); /* 136 */
    int (*tcl_ExprDouble) (Tcl_Interp *interp, const char *expr, double *ptr); /* 137 */
................................................................................
    int (*tcl_UtfToLower) (char *src); /* 334 */
    int (*tcl_UtfToTitle) (char *src); /* 335 */
    int (*tcl_UtfToUniChar) (const char *src, Tcl_UniChar *chPtr); /* 336 */
    int (*tcl_UtfToUpper) (char *src); /* 337 */
    int (*tcl_WriteChars) (Tcl_Channel chan, const char *src, int srcLen); /* 338 */
    int (*tcl_WriteObj) (Tcl_Channel chan, Tcl_Obj *objPtr); /* 339 */
    char * (*tcl_GetString) (Tcl_Obj *objPtr); /* 340 */
    TCL_DEPRECATED_API("Use Tcl_GetEncodingSearchPath") CONST84_RETURN char * (*tcl_GetDefaultEncodingDir) (void); /* 341 */
    TCL_DEPRECATED_API("Use Tcl_SetEncodingSearchPath") void (*tcl_SetDefaultEncodingDir) (const char *path); /* 342 */
    void (*tcl_AlertNotifier) (ClientData clientData); /* 343 */
    void (*tcl_ServiceModeHook) (int mode); /* 344 */
    int (*tcl_UniCharIsAlnum) (int ch); /* 345 */
    int (*tcl_UniCharIsAlpha) (int ch); /* 346 */
    int (*tcl_UniCharIsDigit) (int ch); /* 347 */
    int (*tcl_UniCharIsLower) (int ch); /* 348 */
    int (*tcl_UniCharIsSpace) (int ch); /* 349 */
................................................................................
    int (*tcl_UniCharIsUpper) (int ch); /* 350 */
    int (*tcl_UniCharIsWordChar) (int ch); /* 351 */
    int (*tcl_UniCharLen) (const Tcl_UniChar *uniStr); /* 352 */
    int (*tcl_UniCharNcmp) (const Tcl_UniChar *ucs, const Tcl_UniChar *uct, unsigned long numChars); /* 353 */
    char * (*tcl_UniCharToUtfDString) (const Tcl_UniChar *uniStr, int uniLength, Tcl_DString *dsPtr); /* 354 */
    Tcl_UniChar * (*tcl_UtfToUniCharDString) (const char *src, int length, Tcl_DString *dsPtr); /* 355 */
    Tcl_RegExp (*tcl_GetRegExpFromObj) (Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 356 */
    TCL_DEPRECATED_API("Use Tcl_EvalTokensStandard") Tcl_Obj * (*tcl_EvalTokens) (Tcl_Interp *interp, Tcl_Token *tokenPtr, int count); /* 357 */
    void (*tcl_FreeParse) (Tcl_Parse *parsePtr); /* 358 */
    void (*tcl_LogCommandInfo) (Tcl_Interp *interp, const char *script, const char *command, int length); /* 359 */
    int (*tcl_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 360 */
    int (*tcl_ParseCommand) (Tcl_Interp *interp, const char *start, int numBytes, int nested, Tcl_Parse *parsePtr); /* 361 */
    int (*tcl_ParseExpr) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr); /* 362 */
    int (*tcl_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, CONST84 char **termPtr); /* 363 */
    int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */
................................................................................
    char * (*tcl_AttemptAlloc) (unsigned int size); /* 428 */
    char * (*tcl_AttemptDbCkalloc) (unsigned int size, const char *file, int line); /* 429 */
    char * (*tcl_AttemptRealloc) (char *ptr, unsigned int size); /* 430 */
    char * (*tcl_AttemptDbCkrealloc) (char *ptr, unsigned int size, const char *file, int line); /* 431 */
    int (*tcl_AttemptSetObjLength) (Tcl_Obj *objPtr, int length); /* 432 */
    Tcl_ThreadId (*tcl_GetChannelThread) (Tcl_Channel channel); /* 433 */
    Tcl_UniChar * (*tcl_GetUnicodeFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 434 */
    TCL_DEPRECATED_API("") int (*tcl_GetMathFuncInfo) (Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr); /* 435 */
    TCL_DEPRECATED_API("") Tcl_Obj * (*tcl_ListMathFuncs) (Tcl_Interp *interp, const char *pattern); /* 436 */
    Tcl_Obj * (*tcl_SubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 437 */
    int (*tcl_DetachChannel) (Tcl_Interp *interp, Tcl_Channel channel); /* 438 */
    int (*tcl_IsStandardChannel) (Tcl_Channel channel); /* 439 */
    int (*tcl_FSCopyFile) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr); /* 440 */
    int (*tcl_FSCopyDirectory) (Tcl_Obj *srcPathPtr, Tcl_Obj *destPathPtr, Tcl_Obj **errorPtr); /* 441 */
    int (*tcl_FSCreateDirectory) (Tcl_Obj *pathPtr); /* 442 */
    int (*tcl_FSDeleteFile) (Tcl_Obj *pathPtr); /* 443 */

Changes to generic/tclIOCmd.c.

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
...
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
    case 4:			/* [puts -nonewline $chan $x] or
				 * [puts $chan $x nonewline] */
	newline = 0;
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    chanObjPtr = objv[2];
	    string = objv[3];
	    break;
#if TCL_MAJOR_VERSION < 9
	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */
................................................................................
     * Compute how many bytes to read.
     */

    toRead = -1;
    if (i < objc) {
	if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
		|| (toRead < 0)) {
#if TCL_MAJOR_VERSION < 9
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */

................................................................................
	    if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
#endif
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected non-negative integer but got \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
		return TCL_ERROR;
#if TCL_MAJOR_VERSION < 9
	    }
	    newline = 1;
#endif
	}
    }

    resultPtr = Tcl_NewObj();






|







 







|







 







|







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
...
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
...
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
    case 4:			/* [puts -nonewline $chan $x] or
				 * [puts $chan $x nonewline] */
	newline = 0;
	if (strcmp(TclGetString(objv[1]), "-nonewline") == 0) {
	    chanObjPtr = objv[2];
	    string = objv[3];
	    break;
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	} else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) {
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */
................................................................................
     * Compute how many bytes to read.
     */

    toRead = -1;
    if (i < objc) {
	if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK)
		|| (toRead < 0)) {
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	    /*
	     * The code below provides backwards compatibility with an old
	     * form of the command that is no longer recommended or
	     * documented. See also [Bug #3151675]. Will be removed in Tcl 9,
	     * maybe even earlier.
	     */

................................................................................
	    if (strcmp(TclGetString(objv[i]), "nonewline") != 0) {
#endif
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"expected non-negative integer but got \"%s\"",
			TclGetString(objv[i])));
		Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
		return TCL_ERROR;
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
	    }
	    newline = 1;
#endif
	}
    }

    resultPtr = Tcl_NewObj();

Changes to generic/tclInt.h.

3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#ifndef TCL_NO_DEPRECATED
MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#endif
MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);






|







3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
MODULE_SCOPE Tcl_Command TclInitArrayCmd(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#endif
MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);

Changes to generic/tclStubInit.c.

68
69
70
71
72
73
74








75
76
77
78
79
80
81
#   define TclWinGetServByName 0
#   define TclWinGetSockOpt 0
#   define TclWinSetSockOpt 0
#   define TclWinNToHS 0
#   define TclBNInitBignumFromWideUInt 0
#   define TclBNInitBignumFromWideInt 0
#   define TclBNInitBignumFromLong 0








#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
    Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath






>
>
>
>
>
>
>
>







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
#   define TclWinGetServByName 0
#   define TclWinGetSockOpt 0
#   define TclWinSetSockOpt 0
#   define TclWinNToHS 0
#   define TclBNInitBignumFromWideUInt 0
#   define TclBNInitBignumFromWideInt 0
#   define TclBNInitBignumFromLong 0
#   define Tcl_BackSlash 0
#   define Tcl_EvalFile 0
#   define Tcl_GetDefaultEncodingDir 0
#   define Tcl_SetDefaultEncodingDir 0
#   define Tcl_EvalTokens 0
#   define Tcl_CreateMathFunc 0
#   define Tcl_GetMathFuncInfo 0
#   define Tcl_ListMathFuncs 0
#else
#define TclSetStartupScriptPath setStartupScriptPath
static void TclSetStartupScriptPath(Tcl_Obj *path)
{
    Tcl_SetStartupScript(path, NULL);
}
#define TclGetStartupScriptPath getStartupScriptPath

Changes to generic/tclTest.c.

301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
...
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
...
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
....
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
static int		TestinterpdeleteCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlinkCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlocaleCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#ifndef TCL_NO_DEPRECATED
static int		TestMathFunc(ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr);
static int		TestMathFunc2(ClientData clientData,
			    Tcl_Interp *interp, Tcl_Value *args,
			    Tcl_Value *resultPtr);
#endif /* TCL_NO_DEPRECATED */
static int		TestmainthreadCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestexitmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestpanicCmd(ClientData dummy,
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{
#ifndef TCL_NO_DEPRECATED
    Tcl_ValueType t3ArgTypes[2];
#endif /* TCL_NO_DEPRECATED */

    Tcl_Obj *listPtr;
    Tcl_Obj **objv;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };
................................................................................
    Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testtranslatefilename",
	    TesttranslatefilenameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);
#ifndef TCL_NO_DEPRECATED
    Tcl_CreateMathFunc(interp, "T1", 0, NULL, TestMathFunc, (ClientData) 123);
    Tcl_CreateMathFunc(interp, "T2", 0, NULL, TestMathFunc, (ClientData) 345);
#endif /* TCL_NO_DEPRECATED */
    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
	    NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
    Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
	    (ClientData) 0, NULL);
#endif
#ifndef TCL_NO_DEPRECATED
    t3ArgTypes[0] = TCL_EITHER;
    t3ArgTypes[1] = TCL_EITHER;
    Tcl_CreateMathFunc(interp, "T3", 2, t3ArgTypes, TestMathFunc2,
	    NULL);
#endif /* TCL_NO_DEPRECATED */

    Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);

................................................................................
    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
    }
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestMathFunc --
 *
 *	This is a user-defined math procedure to test out math procedures
 *	with no arguments.
 *
 * Results:
 *	A normal Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
#ifndef TCL_NO_DEPRECATED
static int
TestMathFunc(
    ClientData clientData,	/* Integer value to return. */
    Tcl_Interp *interp,		/* Not used. */
    Tcl_Value *args,		/* Not used. */
    Tcl_Value *resultPtr)	/* Where to store result. */
{
    resultPtr->type = TCL_INT;
    resultPtr->intValue = PTR2INT(clientData);
    return TCL_OK;
}
 
/*
 *----------------------------------------------------------------------
 *
 * TestMathFunc2 --
 *
 *	This is a user-defined math procedure to test out math procedures
 *	that do have arguments, in this case 2.
 *
 * Results:
 *	A normal Tcl completion code.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

	/* ARGSUSED */
static int
TestMathFunc2(
    ClientData clientData,	/* Integer value to return. */
    Tcl_Interp *interp,		/* Used to report errors. */
    Tcl_Value *args,		/* Points to an array of two Tcl_Value structs
				 * for the two arguments. */
    Tcl_Value *resultPtr)	/* Where to store the result. */
{
    int result = TCL_OK;

    /*
     * Return the maximum of the two arguments with the correct type.
     */

    if (args[0].type == TCL_INT) {
	int i0 = args[0].intValue;

	if (args[1].type == TCL_INT) {
	    int i1 = args[1].intValue;

	    resultPtr->type = TCL_INT;
	    resultPtr->intValue = ((i0 > i1)? i0 : i1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d0 = i0;
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    Tcl_WideInt w0 = Tcl_LongAsWide(i0);
	    Tcl_WideInt w1 = args[1].wideValue;

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else {
	    Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
	    result = TCL_ERROR;
	}
    } else if (args[0].type == TCL_DOUBLE) {
	double d0 = args[0].doubleValue;

	if (args[1].type == TCL_INT) {
	    double d1 = args[1].intValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    double d1 = Tcl_WideAsDouble(args[1].wideValue);

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else {
	    Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
	    result = TCL_ERROR;
	}
    } else if (args[0].type == TCL_WIDE_INT) {
	Tcl_WideInt w0 = args[0].wideValue;

	if (args[1].type == TCL_INT) {
	    Tcl_WideInt w1 = Tcl_LongAsWide(args[1].intValue);

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else if (args[1].type == TCL_DOUBLE) {
	    double d0 = Tcl_WideAsDouble(w0);
	    double d1 = args[1].doubleValue;

	    resultPtr->type = TCL_DOUBLE;
	    resultPtr->doubleValue = ((d0 > d1)? d0 : d1);
	} else if (args[1].type == TCL_WIDE_INT) {
	    Tcl_WideInt w1 = args[1].wideValue;

	    resultPtr->type = TCL_WIDE_INT;
	    resultPtr->wideValue = ((w0 > w1)? w0 : w1);
	} else {
	    Tcl_AppendResult(interp, "T3: wrong type for arg 2", NULL);
	    result = TCL_ERROR;
	}
    } else {
	Tcl_AppendResult(interp, "T3: wrong type for arg 1", NULL);
	result = TCL_ERROR;
    }
    return result;
}
#endif /* TCL_NO_DEPRECATED */
 
/*
 *----------------------------------------------------------------------
 *
 * CleanupTestSetassocdataTests --
 *
 *	This function is called when an interpreter is deleted to clean
 *	up any data left over from running the testsetassocdata command.






<
<
<
<
<
<
<
<







 







<
<
<
<







 







<
<
<
<










<
<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







301
302
303
304
305
306
307








308
309
310
311
312
313
314
...
537
538
539
540
541
542
543




544
545
546
547
548
549
550
...
685
686
687
688
689
690
691




692
693
694
695
696
697
698
699
700
701







702
703
704
705
706
707
708
....
3317
3318
3319
3320
3321
3322
3323












































































































































3324
3325
3326
3327
3328
3329
3330
static int		TestinterpdeleteCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlinkCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestlocaleCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);








static int		TestmainthreadCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestexitmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestpanicCmd(ClientData dummy,
................................................................................
 *----------------------------------------------------------------------
 */

int
Tcltest_Init(
    Tcl_Interp *interp)		/* Interpreter for application. */
{




    Tcl_Obj *listPtr;
    Tcl_Obj **objv;
    int objc, index;
    static const char *const specialOptions[] = {
	"-appinitprocerror", "-appinitprocdeleteinterp",
	"-appinitprocclosestderr", "-appinitprocsetrcfile", NULL
    };
................................................................................
    Tcl_CreateCommand(interp, "testsocket", TestSocketCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "teststaticpkg", TeststaticpkgCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testtranslatefilename",
	    TesttranslatefilenameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testupvar", TestupvarCmd, NULL, NULL);




    Tcl_CreateCommand(interp, "testmainthread", TestmainthreadCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testsetmainloop", TestsetmainloopCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testexitmainloop", TestexitmainloopCmd,
	    NULL, NULL);
#if defined(HAVE_CPUID) || defined(_WIN32)
    Tcl_CreateObjCommand(interp, "testcpuid", TestcpuidCmd,
	    (ClientData) 0, NULL);
#endif







    Tcl_CreateObjCommand(interp, "testnreunwind", TestNREUnwind,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testinterpresolver", TestInterpResolverCmd,
	    NULL, NULL);

................................................................................
    locale = setlocale(lcTypes[index], locale);
    if (locale) {
	Tcl_SetStringObj(Tcl_GetObjResult(interp), locale, -1);
    }
    return TCL_OK;
}
 












































































































































/*
 *----------------------------------------------------------------------
 *
 * CleanupTestSetassocdataTests --
 *
 *	This function is called when an interpreter is deleted to clean
 *	up any data left over from running the testsetassocdata command.

Deleted tests/case.test.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
# Commands covered:  case
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands.  Sourcing this file into Tcl runs the tests and
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 1991-1993 The Regents of the University of California.
# Copyright (c) 1994 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {![llength [info commands case]]} {
    # No "case" command? So no need to test
    return
}

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

test case-1.1 {simple pattern} {
    case a in a {format 1} b {format 2} c {format 3} default {format 4}
} 1
test case-1.2 {simple pattern} {
    case b a {format 1} b {format 2} c {format 3} default {format 4}
} 2
test case-1.3 {simple pattern} {
    case x in a {format 1} b {format 2} c {format 3} default {format 4}
} 4
test case-1.4 {simple pattern} {
    case x a {format 1} b {format 2} c {format 3}
} {}
test case-1.5 {simple pattern matches many times} {
    case b a {format 1} b {format 2} b {format 3} b {format 4}
} 2
test case-1.6 {fancier pattern} {
    case cx a {format 1} *c {format 2} *x {format 3} default {format 4}
} 3
test case-1.7 {list of patterns} {
    case abc in {a b c} {format 1} {def abc ghi} {format 2}
} 2

test case-2.1 {error in executed command} {
    list [catch {case a in a {error "Just a test"} default {format 1}} msg] \
	    $msg $::errorInfo
} {1 {Just a test} {Just a test
    while executing
"error "Just a test""
    ("a" arm line 1)
    invoked from within
"case a in a {error "Just a test"} default {format 1}"}}
test case-2.2 {error: not enough args} {
    list [catch {case} msg] $msg
} {1 {wrong # args: should be "case string ?in? ?pattern body ...? ?default body?"}}
test case-2.3 {error: pattern with no body} {
    list [catch {case a b} msg] $msg
} {1 {extra case pattern with no body}}
test case-2.4 {error: pattern with no body} {
    list [catch {case a in b {format 1} c} msg] $msg
} {1 {extra case pattern with no body}}
test case-2.5 {error in default command} {
    list [catch {case foo in a {error case1} default {error case2} \
	    b {error case 3}} msg] $msg $::errorInfo
} {1 case2 {case2
    while executing
"error case2"
    ("default" arm line 1)
    invoked from within
"case foo in a {error case1} default {error case2}  b {error case 3}"}}

test case-3.1 {single-argument form for pattern/command pairs} {
    case b in {
	a {format 1}
	b {format 2}
	default {format 6}
    }
} {2}
test case-3.2 {single-argument form for pattern/command pairs} {
    case b {
	a {format 1}
	b {format 2}
	default {format 6}
    }
} {2}
test case-3.3 {single-argument form for pattern/command pairs} {
    list [catch {case z in {a 2 b}} msg] $msg
} {1 {extra case pattern with no body}}

# cleanup
::tcltest::cleanupTests
return
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<


























































































































































































Changes to tests/compExpr-old.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
...
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
................................................................................
    set ::errorInfo
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
test compExpr-old-15.7 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr 2*T1()
} 246
test compExpr-old-15.8 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T2()*3
} 1035
test compExpr-old-15.9 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(21, 37)
} 37
test compExpr-old-15.10 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(21.2, 37)
} 37.0
test compExpr-old-15.11 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T3(-21.2, -17.5)
} -17.5

test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {
        set i {}
    }






<
<
<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







16
17
18
19
20
21
22






23
24
25
26
27
28
29
...
592
593
594
595
596
597
598
















599
600
601
602
603
604
605
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]







# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
................................................................................
    set ::errorInfo
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test compExpr-old-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
















test compExpr-old-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {
        set i {}
    }

Changes to tests/compExpr.test.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}
 
test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
    expr 1+2
................................................................................

test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
    format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
    expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}
test compExpr-5.3 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr 3*T1()-1
} 368
test compExpr-5.4 {CompileMathFuncCall: call registered math function} testmathfunctions {
    expr T2()*3
} 1035
test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {too few arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
    format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {






<
<
<
<
<
<







 







<
<
<
<
<
<







12
13
14
15
16
17
18






19
20
21
22
23
24
25
...
309
310
311
312
313
314
315






316
317
318
319
320
321
322
    package require tcltest 2
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]







# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}
 
test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {
    expr 1+2
................................................................................

test compExpr-5.1 {CompileMathFuncCall procedure, math function found} {
    format %.6g [expr atan2(1.0, 2.0)]
} 0.463648
test compExpr-5.2 {CompileMathFuncCall procedure, math function not found} -body {
    expr {do_it()}
} -returnCodes error -match glob -result {* "*do_it"}






test compExpr-5.5 {CompileMathFuncCall procedure, too few arguments} -body {
    expr {atan2(1.0)}
} -returnCodes error -match glob -result {too few arguments for math function*}
test compExpr-5.6 {CompileMathFuncCall procedure, complex argument} {
    format %.6g [expr pow(2.1, 27.5-(24.4*(5%2)))]
} 9.97424
test compExpr-5.7 {CompileMathFuncCall procedure, error in argument} -body {

Changes to tests/expr-old.test.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
...
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
...
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit    [expr {int(0x80000000) < 0}]

if {[catch {expr T1()} msg] && $msg eq {invalid command name "tcl::mathfunc::T1"}} {
    testConstraint testmathfunctions 0
} else {
    testConstraint testmathfunctions 1
}

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
................................................................................
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
    list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}
test expr-old-32.43 {math functions in expressions} testmathfunctions {
    expr 2*T1()
} 246
test expr-old-32.44 {math functions in expressions} testmathfunctions {
    expr T2()*3
} 1035
test expr-old-32.45 {math functions in expressions} {
    expr (0 <= rand()) && (rand() < 1)
} {1}
test expr-old-32.46 {math functions in expressions} -body {
    list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
................................................................................
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
    expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
    expr round(-1.0e30)
} -1000000000000000019884624838656
test expr-old-34.17 {errors in math functions} -constraints testmathfunctions \
    -body {
        list [catch {expr T1(4)} msg] $msg
    } -match glob -result {1 {too many arguments for math function*}}

test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
    expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
    set x 0o289
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}






<
<
<
<
<
<







 







<
<
<
<
<
<







 







<
<
<
<
<







20
21
22
23
24
25
26






27
28
29
30
31
32
33
...
837
838
839
840
841
842
843






844
845
846
847
848
849
850
...
936
937
938
939
940
941
942





943
944
945
946
947
948
949
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit    [expr {int(0x80000000) < 0}]







# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {
	{0 0 0 0 0 0 -16 -65 0 0 0 0 0 0 -16 63} {
................................................................................
} -999999999999999949387135297074018866963645011013410073083904
test expr-old-32.41 {math functions in expressions} {
    list [catch {expr pow(1.0 + 3.0 - 2, .8 * 5)} msg] $msg
} {0 16.0}
test expr-old-32.42 {math functions in expressions} {
    list [catch {expr hypot(5*.8,3)} msg] $msg
} {0 5.0}






test expr-old-32.45 {math functions in expressions} {
    expr (0 <= rand()) && (rand() < 1)
} {1}
test expr-old-32.46 {math functions in expressions} -body {
    list [catch {expr rand(24)} msg] $msg
} -match glob -result {1 {too many arguments for math function*}}
test expr-old-32.47 {math functions in expressions} -body {
................................................................................
} -5076964154930102272
test expr-old-34.15 {errors in math functions} {
    expr round(1.0e30)
} 1000000000000000019884624838656
test expr-old-34.16 {errors in math functions} {
    expr round(-1.0e30)
} -1000000000000000019884624838656





test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
    expr 0o289
} -returnCodes error -match glob -result {*invalid octal number*}
test expr-old-36.2 {ExprLooksLikeInt procedure} {
    set x 0o289
    list [catch {expr {$x+1}} msg] $msg
} {1 {can't use invalid octal number as operand of "+"}}

Changes to tests/expr.test.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
...
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testmathfunctions [expr {
    ([catch {expr T1()} msg] != 1) || ($msg ne {invalid command name "tcl::mathfunc::T1"})
}]

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
................................................................................
    set ::errorInfo
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *
test expr-15.7 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr 2*T1()
} 246
test expr-15.8 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T2()*3
} 1035
test expr-15.9 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(21, 37)
} 37
test expr-15.10 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(21.2, 37)
} 37.0
test expr-15.11 {CompileMathFuncCall: call registered math function} {testmathfunctions} {
    expr T3(-21.2, -17.5)
} -17.5
test expr-15.12 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(21, wide(37))
} 37
test expr=15.13 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), 37)
} 37
test expr=15.14 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), wide(37))
} 37
test expr-15.15 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(21.0, wide(37))
} 37.0
test expr-15.16 {ExprCallMathFunc: call registered math function} {testmathfunctions} {
    expr T3(wide(21), 37.0)
} 37.0
test expr-15.17 {ExprCallMathFunc: non-numeric arg} -constraints {
    testmathfunctions
} -body {
    expr T3(0,"a")
} -returnCodes error -result {argument to math function didn't have numeric value}


test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {






<
<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







14
15
16
17
18
19
20




21
22
23
24
25
26
27
...
677
678
679
680
681
682
683



































684
685
686
687
688
689
690
    package require tcltest 2.1
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]





# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {int(0x80000000) < 0}]
testConstraint longIs64bit [expr {int(0x8000000000000000) < 0}]
testConstraint wideIs64bit \
	[expr {(wide(0x80000000) > 0) && (wide(0x8000000000000000) < 0)}]
................................................................................
    set ::errorInfo
} -match glob -result {too few arguments for math function*
    while *ing
"expr pow(1)"}
test expr-15.6 {CompileMathFuncCall: missing ')'} -body {
    expr sin(1
} -returnCodes error -match glob -result *





































test expr-16.1 {GetToken: checks whether integer token starting with "0x" (e.g., "0x$") is invalid} {
    catch {unset a}
    set a(VALUE) ff15
    set i 123
    if {[expr 0x$a(VALUE)] & 16} {