From cf4d5a8cfe114d1b687b43c361a25182eba9597c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 8 Nov 2017 11:50:55 +0000 Subject: TIP #485 implementation: "Remove Deprecated API". Based on Tcl 8.7 (core-8-branch). --- generic/tcl.decls | 16 ++--- generic/tclBasic.c | 2 +- generic/tclCmdAH.c | 2 +- generic/tclDecls.h | 40 +++++++----- generic/tclIOCmd.c | 6 +- generic/tclInt.h | 2 +- generic/tclStubInit.c | 8 +++ generic/tclTest.c | 163 ------------------------------------------------ tests/case.test | 94 ---------------------------- tests/compExpr-old.test | 22 ------- tests/compExpr.test | 12 ---- tests/expr-old.test | 17 ----- tests/expr.test | 39 ------------ 13 files changed, 46 insertions(+), 377 deletions(-) delete mode 100644 tests/case.test diff --git a/generic/tcl.decls b/generic/tcl.decls index b2b91a9..f7ffd29 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -285,7 +285,7 @@ declare 75 { declare 76 { void Tcl_BackgroundError(Tcl_Interp *interp) } -declare 77 { +declare 77 {deprecated {Use Tcl_UtfBackslash}} { char Tcl_Backslash(const char *src, int *readPtr) } declare 78 { @@ -352,7 +352,7 @@ declare 93 { declare 94 { Tcl_Interp *Tcl_CreateInterp(void) } -declare 95 { +declare 95 {deprecated {}} { void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData) @@ -470,7 +470,7 @@ declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } # This is obsolete, use Tcl_FSEvalFile -declare 130 { +declare 130 {deprecated {Use Tcl_FSEvalFile}} { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } declare 131 { @@ -1214,10 +1214,10 @@ declare 339 { declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } -declare 341 { +declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void) } -declare 342 { +declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { void Tcl_SetDefaultEncodingDir(const char *path) } declare 343 { @@ -1266,7 +1266,7 @@ declare 356 { Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags) } -declare 357 { +declare 357 {deprecated {Use Tcl_EvalTokensStandard}} { Tcl_Obj *Tcl_EvalTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, int count) } @@ -1548,12 +1548,12 @@ declare 434 { } # TIP#15 (math function introspection) dkf -declare 435 { +declare 435 {deprecated {}} { int Tcl_GetMathFuncInfo(Tcl_Interp *interp, const char *name, int *numArgsPtr, Tcl_ValueType **argTypesPtr, Tcl_MathProc **procPtr, ClientData *clientDataPtr) } -declare 436 { +declare 436 {deprecated {}} { Tcl_Obj *Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern) } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e6022ac..c334fb8 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -203,7 +203,7 @@ static const CmdInfo builtInCmds[] = { {"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 +#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}, diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 807a1ac..49c8c56 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -164,7 +164,7 @@ Tcl_BreakObjCmd( * *---------------------------------------------------------------------- */ -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* ARGSUSED */ int Tcl_CaseObjCmd( diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 464fc0f..c521845 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -263,7 +263,8 @@ EXTERN int Tcl_AsyncReady(void); /* 76 */ EXTERN void Tcl_BackgroundError(Tcl_Interp *interp); /* 77 */ -EXTERN char Tcl_Backslash(const char *src, int *readPtr); +TCL_DEPRECATED("Use Tcl_UtfBackslash") +char Tcl_Backslash(const char *src, int *readPtr); /* 78 */ EXTERN int Tcl_BadChannelOption(Tcl_Interp *interp, const char *optionName, @@ -322,7 +323,8 @@ EXTERN void Tcl_CreateExitHandler(Tcl_ExitProc *proc, /* 94 */ EXTERN Tcl_Interp * Tcl_CreateInterp(void); /* 95 */ -EXTERN void Tcl_CreateMathFunc(Tcl_Interp *interp, +TCL_DEPRECATED("") +void Tcl_CreateMathFunc(Tcl_Interp *interp, const char *name, int numArgs, Tcl_ValueType *argTypes, Tcl_MathProc *proc, ClientData clientData); @@ -418,7 +420,8 @@ 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, +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); @@ -1010,9 +1013,11 @@ 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); +TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") +CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); /* 342 */ -EXTERN void Tcl_SetDefaultEncodingDir(const char *path); +TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") +void Tcl_SetDefaultEncodingDir(const char *path); /* 343 */ EXTERN void Tcl_AlertNotifier(ClientData clientData); /* 344 */ @@ -1047,7 +1052,8 @@ EXTERN Tcl_UniChar * Tcl_UtfToUniCharDString(const char *src, int length, EXTERN Tcl_RegExp Tcl_GetRegExpFromObj(Tcl_Interp *interp, Tcl_Obj *patObj, int flags); /* 357 */ -EXTERN Tcl_Obj * Tcl_EvalTokens(Tcl_Interp *interp, +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); @@ -1268,13 +1274,15 @@ EXTERN Tcl_ThreadId Tcl_GetChannelThread(Tcl_Channel channel); EXTERN Tcl_UniChar * Tcl_GetUnicodeFromObj(Tcl_Obj *objPtr, int *lengthPtr); /* 435 */ -EXTERN int Tcl_GetMathFuncInfo(Tcl_Interp *interp, +TCL_DEPRECATED("") +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, +TCL_DEPRECATED("") +Tcl_Obj * Tcl_ListMathFuncs(Tcl_Interp *interp, const char *pattern); /* 437 */ EXTERN Tcl_Obj * Tcl_SubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr, @@ -1935,7 +1943,7 @@ typedef struct TclStubs { 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 */ + 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 */ @@ -1953,7 +1961,7 @@ typedef struct TclStubs { 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_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 */ @@ -1988,7 +1996,7 @@ typedef struct TclStubs { 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 */ + 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 */ @@ -2207,8 +2215,8 @@ typedef struct TclStubs { 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 */ + 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 */ @@ -2223,7 +2231,7 @@ typedef struct TclStubs { 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 */ + 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 */ @@ -2301,8 +2309,8 @@ typedef struct TclStubs { 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_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 */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 6e8bd09..87bf415 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -137,7 +137,7 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if TCL_MAJOR_VERSION < 9 +#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 @@ -439,7 +439,7 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if TCL_MAJOR_VERSION < 9 +#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 @@ -454,7 +454,7 @@ Tcl_ReadObjCmd( TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if TCL_MAJOR_VERSION < 9 +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 } newline = 1; #endif diff --git a/generic/tclInt.h b/generic/tclInt.h index 29392b6..6b61af1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3240,7 +3240,7 @@ 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 +#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[]); diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index ebd2086..03ef7d6 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,6 +72,14 @@ static int TclSockMinimumBuffersOld(int sock, int size) # 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) diff --git a/generic/tclTest.c b/generic/tclTest.c index 834cd79..3aa853f 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -305,14 +305,6 @@ static int TestlinkCmd(ClientData dummy, 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, @@ -549,10 +541,6 @@ 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; @@ -701,10 +689,6 @@ Tcltest_Init( 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, @@ -715,13 +699,6 @@ Tcltest_Init( 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, @@ -3347,146 +3324,6 @@ TestlocaleCmd( /* *---------------------------------------------------------------------- * - * 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 diff --git a/tests/case.test b/tests/case.test deleted file mode 100644 index d7558a9..0000000 --- a/tests/case.test +++ /dev/null @@ -1,94 +0,0 @@ -# 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 diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test index bae26a0..0136ccd 100644 --- a/tests/compExpr-old.test +++ b/tests/compExpr-old.test @@ -20,12 +20,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::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 {} { @@ -602,22 +596,6 @@ test compExpr-old-15.5 {CompileMathFuncCall: too few arguments} -body { 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 diff --git a/tests/compExpr.test b/tests/compExpr.test index 14c875d..3b44af8 100644 --- a/tests/compExpr.test +++ b/tests/compExpr.test @@ -16,12 +16,6 @@ if {"::tcltest" ni [namespace children]} { ::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]] @@ -319,12 +313,6 @@ test compExpr-5.1 {CompileMathFuncCall procedure, math function found} { 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*} diff --git a/tests/expr-old.test b/tests/expr-old.test index 3adfb63..cea20f1 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -24,12 +24,6 @@ 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 {} { @@ -847,12 +841,6 @@ test expr-old-32.41 {math functions in expressions} { 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} @@ -952,11 +940,6 @@ test expr-old-34.15 {errors in math functions} { 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*} diff --git a/tests/expr.test b/tests/expr.test index 8e083c5..0b3620a 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -18,10 +18,6 @@ if {[lsearch [namespace children] ::tcltest] == -1} { ::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. @@ -685,41 +681,6 @@ test expr-15.5 {CompileMathFuncCall: too few arguments} -body { 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} { -- cgit v0.12 From 429acda3ee22bea891e82e69efc09872e7608915 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 10:34:10 +0000 Subject: Put Tcl_EvalFile back, but then as a macro in terms of Tcl_FSEvalFileEx(). --- generic/tclDecls.h | 3 +++ generic/tclIOUtil.c | 24 +++++++++++------------- generic/tclStubInit.c | 2 ++ 3 files changed, 16 insertions(+), 13 deletions(-) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index c521845..7718588 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3984,5 +3984,8 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GlobalEvalObj #define Tcl_GlobalEvalObj(interp, objPtr) \ Tcl_EvalObjEx(interp, objPtr, TCL_EVAL_GLOBAL) +#undef Tcl_EvalFile +#define Tcl_EvalFile(interp, fileName) \ + Tcl_FSEvalFileEx(interp, Tcl_NewStringObj(filename, -1), NULL); #endif /* _TCLDECLS */ diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 2c389c6..39a9474 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -412,21 +412,18 @@ Tcl_GetCwd( return Tcl_DStringValue(cwdPtr); } +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* Obsolete */ +#undef Tcl_EvalFile int Tcl_EvalFile( Tcl_Interp *interp, /* Interpreter in which to process file. */ const char *fileName) /* Name of file to process. Tilde-substitution * will be performed on this name. */ { - int ret; - Tcl_Obj *pathPtr = Tcl_NewStringObj(fileName,-1); - - Tcl_IncrRefCount(pathPtr); - ret = Tcl_FSEvalFile(interp, pathPtr); - Tcl_DecrRefCount(pathPtr); - return ret; + return Tcl_FSEvalFileEx(interp, Tcl_NewStringObj(fileName, -1), NULL); } +#endif /* * Now move on to the basic filesystem implementation. @@ -1740,8 +1737,11 @@ Tcl_FSEvalFileEx( Tcl_Channel chan; Tcl_Obj *objPtr; + Tcl_IncrRefCount(pathPtr); + objPtr = Tcl_NewObj(); + Tcl_IncrRefCount(objPtr); if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { - return result; + goto end; } if (Tcl_FSStat(pathPtr, &statBuf) == -1) { @@ -1756,7 +1756,7 @@ Tcl_FSEvalFileEx( Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't read file \"%s\": %s", Tcl_GetString(pathPtr), Tcl_PosixError(interp))); - return result; + goto end; } /* @@ -1775,13 +1775,10 @@ Tcl_FSEvalFileEx( if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { Tcl_Close(interp,chan); - return result; + goto end; } } - objPtr = Tcl_NewObj(); - Tcl_IncrRefCount(objPtr); - /* * Try to read first character of stream, so we can check for utf-8 BOM to * be handled especially. @@ -1857,6 +1854,7 @@ Tcl_FSEvalFileEx( end: Tcl_DecrRefCount(objPtr); + Tcl_DecrRefCount(pathPtr); return result; } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 03ef7d6..eacc8ca 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -371,6 +371,8 @@ static int formatInt(char *buffer, int n){ # define Tcl_EvalObj 0 # undef Tcl_GlobalEvalObj # define Tcl_GlobalEvalObj 0 +# undef Tcl_EvalFile +# define Tcl_EvalFile 0 # define TclBackgroundException 0 # undef TclpReaddir # define TclpReaddir 0 -- cgit v0.12 From 56e7df256a6fc22cd478e4be02a8dca93634e942 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 11:04:49 +0000 Subject: No longer mark Tcl_EvalFile() as obsolete/deprecated. Thanks to all feedback to TIP #485! --- generic/tcl.decls | 4 ++-- generic/tclDecls.h | 5 ++--- generic/tclEncoding.c | 2 ++ generic/tclStubInit.c | 3 +-- 4 files changed, 7 insertions(+), 7 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index f7ffd29..1083adc 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -469,8 +469,8 @@ declare 128 { declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) } -# This is obsolete, use Tcl_FSEvalFile -declare 130 {deprecated {Use Tcl_FSEvalFile}} { +# Stub entry no longer needed. It is now a macro in terms of Tcl_FSEvalFileEx(). +declare 130 { int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName) } declare 131 { diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 7718588..9241175 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -420,8 +420,7 @@ 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, +EXTERN int Tcl_EvalFile(Tcl_Interp *interp, const char *fileName); /* 131 */ EXTERN int Tcl_EvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); @@ -1996,7 +1995,7 @@ typedef struct TclStubs { 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_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 */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 1f48a1c..b0c595c 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -693,6 +693,7 @@ TclFinalizeEncodingSubsystem(void) *------------------------------------------------------------------------- */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 const char * Tcl_GetDefaultEncodingDir(void) { @@ -736,6 +737,7 @@ Tcl_SetDefaultEncodingDir( Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); Tcl_SetEncodingSearchPath(searchPath); } +#endif /* *------------------------------------------------------------------------- diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index eacc8ca..d276dbc 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -72,8 +72,7 @@ static int TclSockMinimumBuffersOld(int sock, int size) # define TclBNInitBignumFromWideUInt 0 # define TclBNInitBignumFromWideInt 0 # define TclBNInitBignumFromLong 0 -# define Tcl_BackSlash 0 -# define Tcl_EvalFile 0 +# define Tcl_Backslash 0 # define Tcl_GetDefaultEncodingDir 0 # define Tcl_SetDefaultEncodingDir 0 # define Tcl_EvalTokens 0 -- cgit v0.12 From a037934e2165dc52888a2daa656c9e5d5ddc980e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 9 Nov 2017 11:49:10 +0000 Subject: Get rid of Tcl_DStringTrunc et al, as described in the TIP (Thanks, Don!). --- generic/tcl.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index 80c8dcb..54c6b73 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -997,7 +997,7 @@ typedef struct Tcl_DString { #define Tcl_DStringLength(dsPtr) ((dsPtr)->length) #define Tcl_DStringValue(dsPtr) ((dsPtr)->string) -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # define Tcl_DStringTrunc Tcl_DStringSetLength #endif /* !TCL_NO_DEPRECATED */ @@ -2615,7 +2615,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); * Deprecated Tcl functions: */ -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 /* * These function have been renamed. The old names are deprecated, but we * define these macros for backwards compatibilty. -- cgit v0.12 From 52b098ca11d6cbae8661a4d1e1461335674f2ce2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 20 Nov 2017 16:26:03 +0000 Subject: Deprecate support for macro's like CONST, CONST84, _ANSI_ARGS_, INLINE, TCL_VARARGS --- generic/tcl.decls | 82 +++++++++++------------ generic/tcl.h | 41 +++--------- generic/tclDecls.h | 181 ++++++++++++++++++++++++-------------------------- generic/tclInt.decls | 10 +-- generic/tclInt.h | 6 +- generic/tclIntDecls.h | 14 ++-- 6 files changed, 153 insertions(+), 181 deletions(-) diff --git a/generic/tcl.decls b/generic/tcl.decls index fd7468a..60aebfd 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -32,7 +32,7 @@ declare 0 { const char *version, const void *clientData) } declare 1 { - CONST84_RETURN char *Tcl_PkgRequireEx(Tcl_Interp *interp, + const char *Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } @@ -154,7 +154,7 @@ declare 35 { } declare 36 { int Tcl_GetIndexFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr) + const char *const *tablePtr, const char *msg, int flags, int *indexPtr) } declare 37 { int Tcl_GetInt(Tcl_Interp *interp, const char *src, int *intPtr) @@ -306,7 +306,7 @@ declare 82 { int Tcl_CommandComplete(const char *cmd) } declare 83 { - char *Tcl_Concat(int argc, CONST84 char *const *argv) + char *Tcl_Concat(int argc, const char *const *argv) } declare 84 { int Tcl_ConvertElement(const char *src, char *dst, int flags) @@ -318,7 +318,7 @@ declare 85 { declare 86 { int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, - CONST84 char *const *argv) + const char *const *argv) } declare 87 { int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, @@ -461,10 +461,10 @@ declare 126 { int Tcl_Eof(Tcl_Channel chan) } declare 127 { - CONST84_RETURN char *Tcl_ErrnoId(void) + const char *Tcl_ErrnoId(void) } declare 128 { - CONST84_RETURN char *Tcl_ErrnoMsg(int err) + const char *Tcl_ErrnoMsg(int err) } declare 129 { int Tcl_Eval(Tcl_Interp *interp, const char *script) @@ -528,12 +528,12 @@ declare 147 { } declare 148 { int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, - int *argcPtr, CONST84 char ***argvPtr) + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, + int *argcPtr, const char ***argvPtr) } declare 149 { int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, - Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, + Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv) } declare 150 { @@ -558,7 +558,7 @@ declare 155 { int Tcl_GetChannelMode(Tcl_Channel chan) } declare 156 { - CONST84_RETURN char *Tcl_GetChannelName(Tcl_Channel chan) + const char *Tcl_GetChannelName(Tcl_Channel chan) } declare 157 { int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, @@ -572,14 +572,14 @@ declare 159 { Tcl_CmdInfo *infoPtr) } declare 160 { - CONST84_RETURN char *Tcl_GetCommandName(Tcl_Interp *interp, + const char *Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command) } declare 161 { int Tcl_GetErrno(void) } declare 162 { - CONST84_RETURN char *Tcl_GetHostName(void) + const char *Tcl_GetHostName(void) } declare 163 { int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp) @@ -622,14 +622,14 @@ declare 173 { Tcl_Channel Tcl_GetStdChannel(int type) } declare 174 { - CONST84_RETURN char *Tcl_GetStringResult(Tcl_Interp *interp) + const char *Tcl_GetStringResult(Tcl_Interp *interp) } declare 175 { - CONST84_RETURN char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, + const char *Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags) } declare 176 { - CONST84_RETURN char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, + const char *Tcl_GetVar2(Tcl_Interp *interp, const char *part1, const char *part2, int flags) } declare 177 { @@ -662,7 +662,7 @@ declare 185 { } # Obsolete, use Tcl_FSJoinPath declare 186 { - char *Tcl_JoinPath(int argc, CONST84 char *const *argv, + char *Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr) } declare 187 { @@ -685,7 +685,7 @@ declare 191 { Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket) } declare 192 { - char *Tcl_Merge(int argc, CONST84 char *const *argv) + char *Tcl_Merge(int argc, const char *const *argv) } declare 193 { Tcl_HashEntry *Tcl_NextHashEntry(Tcl_HashSearch *searchPtr) @@ -703,7 +703,7 @@ declare 196 { } declare 197 { Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, - CONST84 char **argv, int flags) + const char **argv, int flags) } # This is obsolete, use Tcl_FSOpenFileChannel declare 198 { @@ -729,7 +729,7 @@ declare 203 { int Tcl_PutEnv(const char *assignment) } declare 204 { - CONST84_RETURN char *Tcl_PosixError(Tcl_Interp *interp) + const char *Tcl_PosixError(Tcl_Interp *interp) } declare 205 { void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position) @@ -765,7 +765,7 @@ declare 214 { } declare 215 { void Tcl_RegExpRange(Tcl_RegExp regexp, int index, - CONST84 char **startPtr, CONST84 char **endPtr) + const char **startPtr, const char **endPtr) } declare 216 { void Tcl_Release(ClientData clientData) @@ -835,29 +835,29 @@ declare 236 { void Tcl_SetStdChannel(Tcl_Channel channel, int type) } declare 237 { - CONST84_RETURN char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, + const char *Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags) } declare 238 { - CONST84_RETURN char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, + const char *Tcl_SetVar2(Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags) } declare 239 { - CONST84_RETURN char *Tcl_SignalId(int sig) + const char *Tcl_SignalId(int sig) } declare 240 { - CONST84_RETURN char *Tcl_SignalMsg(int sig) + const char *Tcl_SignalMsg(int sig) } declare 241 { void Tcl_SourceRCFile(Tcl_Interp *interp) } declare 242 { int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, - CONST84 char ***argvPtr) + const char ***argvPtr) } # Obsolete, use Tcl_FSSplitPath declare 243 { - void Tcl_SplitPath(const char *path, int *argcPtr, CONST84 char ***argvPtr) + void Tcl_SplitPath(const char *path, int *argcPtr, const char ***argvPtr) } declare 244 { void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, @@ -952,15 +952,15 @@ declare 269 { char *Tcl_HashStats(Tcl_HashTable *tablePtr) } declare 270 { - CONST84_RETURN char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, - CONST84 char **termPtr) + const char *Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr) } declare 271 { - CONST84_RETURN char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *Tcl_PkgPresent(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 272 { - CONST84_RETURN char *Tcl_PkgPresentEx(Tcl_Interp *interp, + const char *Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr) } @@ -970,7 +970,7 @@ declare 273 { } # TIP #268: The internally used new Require function is in slot 573. declare 274 { - CONST84_RETURN char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *Tcl_PkgRequire(Tcl_Interp *interp, const char *name, const char *version, int exact) } declare 275 {deprecated {see TIP #422}} { @@ -1084,7 +1084,7 @@ declare 301 { Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name) } declare 302 { - CONST84_RETURN char *Tcl_GetEncodingName(Tcl_Encoding encoding) + const char *Tcl_GetEncodingName(Tcl_Encoding encoding) } declare 303 { void Tcl_GetEncodingNames(Tcl_Interp *interp) @@ -1160,7 +1160,7 @@ declare 324 { int Tcl_UniCharToUtf(int ch, char *buf) } declare 325 { - CONST84_RETURN char *Tcl_UtfAtIndex(const char *src, int index) + const char *Tcl_UtfAtIndex(const char *src, int index) } declare 326 { int Tcl_UtfCharComplete(const char *src, int length) @@ -1169,16 +1169,16 @@ declare 327 { int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst) } declare 328 { - CONST84_RETURN char *Tcl_UtfFindFirst(const char *src, int ch) + const char *Tcl_UtfFindFirst(const char *src, int ch) } declare 329 { - CONST84_RETURN char *Tcl_UtfFindLast(const char *src, int ch) + const char *Tcl_UtfFindLast(const char *src, int ch) } declare 330 { - CONST84_RETURN char *Tcl_UtfNext(const char *src) + const char *Tcl_UtfNext(const char *src) } declare 331 { - CONST84_RETURN char *Tcl_UtfPrev(const char *src, const char *start) + const char *Tcl_UtfPrev(const char *src, const char *start) } declare 332 { int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, @@ -1212,7 +1212,7 @@ declare 340 { char *Tcl_GetString(Tcl_Obj *objPtr) } declare 341 {deprecated {Use Tcl_GetEncodingSearchPath}} { - CONST84_RETURN char *Tcl_GetDefaultEncodingDir(void) + const char *Tcl_GetDefaultEncodingDir(void) } declare 342 {deprecated {Use Tcl_SetEncodingSearchPath}} { void Tcl_SetDefaultEncodingDir(const char *path) @@ -1276,7 +1276,7 @@ declare 359 { } declare 360 { int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, - Tcl_Parse *parsePtr, int append, CONST84 char **termPtr) + Tcl_Parse *parsePtr, int append, const char **termPtr) } declare 361 { int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, @@ -1289,7 +1289,7 @@ declare 362 { declare 363 { int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr) + const char **termPtr) } declare 364 { int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, @@ -1405,7 +1405,7 @@ declare 397 { int Tcl_ChannelBuffered(Tcl_Channel chan) } declare 398 { - CONST84_RETURN char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) + const char *Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr) } declare 399 { Tcl_ChannelTypeVersion Tcl_ChannelVersion( diff --git a/generic/tcl.h b/generic/tcl.h index 23a0a9a..e054c19 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -137,7 +137,7 @@ extern "C" { */ #include -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # define TCL_VARARGS(type, name) (type name, ...) # define TCL_VARARGS_DEF(type, name) (type name, ...) # define TCL_VARARGS_START(type, name, list) (va_start(list, name), name) @@ -254,10 +254,9 @@ extern "C" { * New code should use prototypes. */ -#ifndef TCL_NO_DEPRECATED +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 # undef _ANSI_ARGS_ # define _ANSI_ARGS_(x) x -#endif /* !TCL_NO_DEPRECATED */ /* * Definitions that allow this header file to be used either with or without @@ -267,34 +266,16 @@ extern "C" { #ifndef INLINE # define INLINE #endif - -#ifdef NO_CONST -# ifndef const -# define const -# endif -#endif #ifndef CONST # define CONST const #endif +#define CONST84 const +#define CONST84_RETURN const -#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 -# ifdef USE_COMPAT_CONST -# define CONST84 -# define CONST84_RETURN const -# else -# define CONST84 const -# define CONST84_RETURN const -# endif -#endif +#endif /* !TCL_NO_DEPRECATED */ #ifndef CONST86 -# define CONST86 CONST84 +# define CONST86 const #endif /* @@ -720,10 +701,10 @@ typedef void (Tcl_ChannelProc) (ClientData clientData, int mask); typedef void (Tcl_CloseProc) (ClientData data); typedef void (Tcl_CmdDeleteProc) (ClientData clientData); typedef int (Tcl_CmdProc) (ClientData clientData, Tcl_Interp *interp, - int argc, CONST84 char *argv[]); + int argc, const char *argv[]); typedef void (Tcl_CmdTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, char *command, Tcl_CmdProc *proc, - ClientData cmdClientData, int argc, CONST84 char *argv[]); + ClientData cmdClientData, int argc, const char *argv[]); typedef int (Tcl_CmdObjTraceProc) (ClientData clientData, Tcl_Interp *interp, int level, const char *command, Tcl_Command commandInfo, int objc, struct Tcl_Obj *const *objv); @@ -760,7 +741,7 @@ typedef void (Tcl_TimerProc) (ClientData clientData); typedef int (Tcl_SetFromAnyProc) (Tcl_Interp *interp, struct Tcl_Obj *objPtr); typedef void (Tcl_UpdateStringProc) (struct Tcl_Obj *objPtr); typedef char * (Tcl_VarTraceProc) (ClientData clientData, Tcl_Interp *interp, - CONST84 char *part1, CONST84 char *part2, int flags); + const char *part1, const char *part2, int flags); typedef void (Tcl_CommandTraceProc) (ClientData clientData, Tcl_Interp *interp, const char *oldName, const char *newName, int flags); typedef void (Tcl_CreateFileHandlerProc) (int fd, int mask, Tcl_FileProc *proc, @@ -1478,14 +1459,14 @@ typedef int (Tcl_DriverClose2Proc) (ClientData instanceData, typedef int (Tcl_DriverInputProc) (ClientData instanceData, char *buf, int toRead, int *errorCodePtr); typedef int (Tcl_DriverOutputProc) (ClientData instanceData, - CONST84 char *buf, int toWrite, int *errorCodePtr); + const char *buf, int toWrite, int *errorCodePtr); typedef int (Tcl_DriverSeekProc) (ClientData instanceData, long offset, int mode, int *errorCodePtr); typedef int (Tcl_DriverSetOptionProc) (ClientData instanceData, Tcl_Interp *interp, const char *optionName, const char *value); typedef int (Tcl_DriverGetOptionProc) (ClientData instanceData, - Tcl_Interp *interp, CONST84 char *optionName, + Tcl_Interp *interp, const char *optionName, Tcl_DString *dsPtr); typedef void (Tcl_DriverWatchProc) (ClientData instanceData, int mask); typedef int (Tcl_DriverGetHandleProc) (ClientData instanceData, diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3afe45a..0c1505b 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -53,7 +53,7 @@ EXTERN int Tcl_PkgProvideEx(Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 1 */ -EXTERN CONST84_RETURN char * Tcl_PkgRequireEx(Tcl_Interp *interp, +EXTERN const char * Tcl_PkgRequireEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 2 */ @@ -159,8 +159,7 @@ EXTERN int Tcl_GetDoubleFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 36 */ EXTERN int Tcl_GetIndexFromObj(Tcl_Interp *interp, - Tcl_Obj *objPtr, - CONST84 char *const *tablePtr, + Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 37 */ EXTERN int Tcl_GetInt(Tcl_Interp *interp, const char *src, @@ -281,7 +280,7 @@ EXTERN int Tcl_Close(Tcl_Interp *interp, Tcl_Channel chan); /* 82 */ EXTERN int Tcl_CommandComplete(const char *cmd); /* 83 */ -EXTERN char * Tcl_Concat(int argc, CONST84 char *const *argv); +EXTERN char * Tcl_Concat(int argc, const char *const *argv); /* 84 */ EXTERN int Tcl_ConvertElement(const char *src, char *dst, int flags); @@ -292,7 +291,7 @@ EXTERN int Tcl_ConvertCountedElement(const char *src, EXTERN int Tcl_CreateAlias(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, - CONST84 char *const *argv); + const char *const *argv); /* 87 */ EXTERN int Tcl_CreateAliasObj(Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, @@ -414,9 +413,9 @@ EXTERN void Tcl_DStringStartSublist(Tcl_DString *dsPtr); /* 126 */ EXTERN int Tcl_Eof(Tcl_Channel chan); /* 127 */ -EXTERN CONST84_RETURN char * Tcl_ErrnoId(void); +EXTERN const char * Tcl_ErrnoId(void); /* 128 */ -EXTERN CONST84_RETURN char * Tcl_ErrnoMsg(int err); +EXTERN const char * Tcl_ErrnoMsg(int err); /* 129 */ EXTERN int Tcl_Eval(Tcl_Interp *interp, const char *script); /* 130 */ @@ -471,13 +470,13 @@ EXTERN void Tcl_FreeResult(Tcl_Interp *interp); EXTERN int Tcl_GetAlias(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, - CONST84 char **targetCmdPtr, int *argcPtr, - CONST84 char ***argvPtr); + const char **targetCmdPtr, int *argcPtr, + const char ***argvPtr); /* 149 */ EXTERN int Tcl_GetAliasObj(Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, - CONST84 char **targetCmdPtr, int *objcPtr, + const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 150 */ EXTERN ClientData Tcl_GetAssocData(Tcl_Interp *interp, @@ -496,7 +495,7 @@ EXTERN ClientData Tcl_GetChannelInstanceData(Tcl_Channel chan); /* 155 */ EXTERN int Tcl_GetChannelMode(Tcl_Channel chan); /* 156 */ -EXTERN CONST84_RETURN char * Tcl_GetChannelName(Tcl_Channel chan); +EXTERN const char * Tcl_GetChannelName(Tcl_Channel chan); /* 157 */ EXTERN int Tcl_GetChannelOption(Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, @@ -507,12 +506,12 @@ EXTERN CONST86 Tcl_ChannelType * Tcl_GetChannelType(Tcl_Channel chan); EXTERN int Tcl_GetCommandInfo(Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 160 */ -EXTERN CONST84_RETURN char * Tcl_GetCommandName(Tcl_Interp *interp, +EXTERN const char * Tcl_GetCommandName(Tcl_Interp *interp, Tcl_Command command); /* 161 */ EXTERN int Tcl_GetErrno(void); /* 162 */ -EXTERN CONST84_RETURN char * Tcl_GetHostName(void); +EXTERN const char * Tcl_GetHostName(void); /* 163 */ EXTERN int Tcl_GetInterpPath(Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); @@ -548,14 +547,13 @@ EXTERN Tcl_Interp * Tcl_GetSlave(Tcl_Interp *interp, /* 173 */ EXTERN Tcl_Channel Tcl_GetStdChannel(int type); /* 174 */ -EXTERN CONST84_RETURN char * Tcl_GetStringResult(Tcl_Interp *interp); +EXTERN const char * Tcl_GetStringResult(Tcl_Interp *interp); /* 175 */ -EXTERN CONST84_RETURN char * Tcl_GetVar(Tcl_Interp *interp, - const char *varName, int flags); -/* 176 */ -EXTERN CONST84_RETURN char * Tcl_GetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, +EXTERN const char * Tcl_GetVar(Tcl_Interp *interp, const char *varName, int flags); +/* 176 */ +EXTERN const char * Tcl_GetVar2(Tcl_Interp *interp, const char *part1, + const char *part2, int flags); /* 177 */ EXTERN int Tcl_GlobalEval(Tcl_Interp *interp, const char *command); @@ -580,7 +578,7 @@ EXTERN int Tcl_InterpDeleted(Tcl_Interp *interp); /* 185 */ EXTERN int Tcl_IsSafe(Tcl_Interp *interp); /* 186 */ -EXTERN char * Tcl_JoinPath(int argc, CONST84 char *const *argv, +EXTERN char * Tcl_JoinPath(int argc, const char *const *argv, Tcl_DString *resultPtr); /* 187 */ EXTERN int Tcl_LinkVar(Tcl_Interp *interp, const char *varName, @@ -593,7 +591,7 @@ EXTERN int Tcl_MakeSafe(Tcl_Interp *interp); /* 191 */ EXTERN Tcl_Channel Tcl_MakeTcpClientChannel(ClientData tcpSocket); /* 192 */ -EXTERN char * Tcl_Merge(int argc, CONST84 char *const *argv); +EXTERN char * Tcl_Merge(int argc, const char *const *argv); /* 193 */ EXTERN Tcl_HashEntry * Tcl_NextHashEntry(Tcl_HashSearch *searchPtr); /* 194 */ @@ -607,7 +605,7 @@ EXTERN Tcl_Obj * Tcl_ObjSetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, int flags); /* 197 */ EXTERN Tcl_Channel Tcl_OpenCommandChannel(Tcl_Interp *interp, int argc, - CONST84 char **argv, int flags); + const char **argv, int flags); /* 198 */ EXTERN Tcl_Channel Tcl_OpenFileChannel(Tcl_Interp *interp, const char *fileName, const char *modeString, @@ -629,7 +627,7 @@ EXTERN void Tcl_PrintDouble(Tcl_Interp *interp, double value, /* 203 */ EXTERN int Tcl_PutEnv(const char *assignment); /* 204 */ -EXTERN CONST84_RETURN char * Tcl_PosixError(Tcl_Interp *interp); +EXTERN const char * Tcl_PosixError(Tcl_Interp *interp); /* 205 */ EXTERN void Tcl_QueueEvent(Tcl_Event *evPtr, Tcl_QueuePosition position); @@ -659,8 +657,7 @@ EXTERN int Tcl_RegExpMatch(Tcl_Interp *interp, const char *text, const char *pattern); /* 215 */ EXTERN void Tcl_RegExpRange(Tcl_RegExp regexp, int index, - CONST84 char **startPtr, - CONST84 char **endPtr); + const char **startPtr, const char **endPtr); /* 216 */ EXTERN void Tcl_Release(ClientData clientData); /* 217 */ @@ -716,26 +713,25 @@ EXTERN void Tcl_SetObjResult(Tcl_Interp *interp, /* 236 */ EXTERN void Tcl_SetStdChannel(Tcl_Channel channel, int type); /* 237 */ -EXTERN CONST84_RETURN char * Tcl_SetVar(Tcl_Interp *interp, - const char *varName, const char *newValue, - int flags); -/* 238 */ -EXTERN CONST84_RETURN char * Tcl_SetVar2(Tcl_Interp *interp, - const char *part1, const char *part2, +EXTERN const char * Tcl_SetVar(Tcl_Interp *interp, const char *varName, const char *newValue, int flags); +/* 238 */ +EXTERN const char * Tcl_SetVar2(Tcl_Interp *interp, const char *part1, + const char *part2, const char *newValue, + int flags); /* 239 */ -EXTERN CONST84_RETURN char * Tcl_SignalId(int sig); +EXTERN const char * Tcl_SignalId(int sig); /* 240 */ -EXTERN CONST84_RETURN char * Tcl_SignalMsg(int sig); +EXTERN const char * Tcl_SignalMsg(int sig); /* 241 */ EXTERN void Tcl_SourceRCFile(Tcl_Interp *interp); /* 242 */ EXTERN int Tcl_SplitList(Tcl_Interp *interp, const char *listStr, int *argcPtr, - CONST84 char ***argvPtr); + const char ***argvPtr); /* 243 */ EXTERN void Tcl_SplitPath(const char *path, int *argcPtr, - CONST84 char ***argvPtr); + const char ***argvPtr); /* 244 */ EXTERN void Tcl_StaticPackage(Tcl_Interp *interp, const char *pkgName, @@ -826,23 +822,21 @@ void Tcl_AppendStringsToObjVA(Tcl_Obj *objPtr, /* 269 */ EXTERN char * Tcl_HashStats(Tcl_HashTable *tablePtr); /* 270 */ -EXTERN CONST84_RETURN char * Tcl_ParseVar(Tcl_Interp *interp, - const char *start, CONST84 char **termPtr); +EXTERN const char * Tcl_ParseVar(Tcl_Interp *interp, const char *start, + const char **termPtr); /* 271 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresent(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +EXTERN const char * Tcl_PkgPresent(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 272 */ -EXTERN CONST84_RETURN char * Tcl_PkgPresentEx(Tcl_Interp *interp, +EXTERN const char * Tcl_PkgPresentEx(Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 273 */ EXTERN int Tcl_PkgProvide(Tcl_Interp *interp, const char *name, const char *version); /* 274 */ -EXTERN CONST84_RETURN char * Tcl_PkgRequire(Tcl_Interp *interp, - const char *name, const char *version, - int exact); +EXTERN const char * Tcl_PkgRequire(Tcl_Interp *interp, const char *name, + const char *version, int exact); /* 275 */ TCL_DEPRECATED("see TIP #422") void Tcl_SetErrorCodeVA(Tcl_Interp *interp, @@ -919,7 +913,7 @@ EXTERN Tcl_ThreadId Tcl_GetCurrentThread(void); /* 301 */ EXTERN Tcl_Encoding Tcl_GetEncoding(Tcl_Interp *interp, const char *name); /* 302 */ -EXTERN CONST84_RETURN char * Tcl_GetEncodingName(Tcl_Encoding encoding); +EXTERN const char * Tcl_GetEncodingName(Tcl_Encoding encoding); /* 303 */ EXTERN void Tcl_GetEncodingNames(Tcl_Interp *interp); /* 304 */ @@ -978,20 +972,20 @@ EXTERN Tcl_UniChar Tcl_UniCharToUpper(int ch); /* 324 */ EXTERN int Tcl_UniCharToUtf(int ch, char *buf); /* 325 */ -EXTERN CONST84_RETURN char * Tcl_UtfAtIndex(const char *src, int index); +EXTERN const char * Tcl_UtfAtIndex(const char *src, int index); /* 326 */ EXTERN int Tcl_UtfCharComplete(const char *src, int length); /* 327 */ EXTERN int Tcl_UtfBackslash(const char *src, int *readPtr, char *dst); /* 328 */ -EXTERN CONST84_RETURN char * Tcl_UtfFindFirst(const char *src, int ch); +EXTERN const char * Tcl_UtfFindFirst(const char *src, int ch); /* 329 */ -EXTERN CONST84_RETURN char * Tcl_UtfFindLast(const char *src, int ch); +EXTERN const char * Tcl_UtfFindLast(const char *src, int ch); /* 330 */ -EXTERN CONST84_RETURN char * Tcl_UtfNext(const char *src); +EXTERN const char * Tcl_UtfNext(const char *src); /* 331 */ -EXTERN CONST84_RETURN char * Tcl_UtfPrev(const char *src, const char *start); +EXTERN const char * Tcl_UtfPrev(const char *src, const char *start); /* 332 */ EXTERN int Tcl_UtfToExternal(Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, @@ -1020,7 +1014,7 @@ EXTERN int Tcl_WriteObj(Tcl_Channel chan, Tcl_Obj *objPtr); EXTERN char * Tcl_GetString(Tcl_Obj *objPtr); /* 341 */ TCL_DEPRECATED("Use Tcl_GetEncodingSearchPath") -CONST84_RETURN char * Tcl_GetDefaultEncodingDir(void); +const char * Tcl_GetDefaultEncodingDir(void); /* 342 */ TCL_DEPRECATED("Use Tcl_SetEncodingSearchPath") void Tcl_SetDefaultEncodingDir(const char *path); @@ -1071,7 +1065,7 @@ EXTERN void Tcl_LogCommandInfo(Tcl_Interp *interp, EXTERN int Tcl_ParseBraces(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr); + const char **termPtr); /* 361 */ EXTERN int Tcl_ParseCommand(Tcl_Interp *interp, const char *start, int numBytes, int nested, @@ -1083,7 +1077,7 @@ EXTERN int Tcl_ParseExpr(Tcl_Interp *interp, const char *start, EXTERN int Tcl_ParseQuotedString(Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, - CONST84 char **termPtr); + const char **termPtr); /* 364 */ EXTERN int Tcl_ParseVarName(Tcl_Interp *interp, const char *start, int numBytes, @@ -1173,8 +1167,7 @@ EXTERN Tcl_Channel Tcl_GetTopChannel(Tcl_Channel chan); /* 397 */ EXTERN int Tcl_ChannelBuffered(Tcl_Channel chan); /* 398 */ -EXTERN CONST84_RETURN char * Tcl_ChannelName( - const Tcl_ChannelType *chanTypePtr); +EXTERN const char * Tcl_ChannelName(const Tcl_ChannelType *chanTypePtr); /* 399 */ EXTERN Tcl_ChannelTypeVersion Tcl_ChannelVersion( const Tcl_ChannelType *chanTypePtr); @@ -1857,7 +1850,7 @@ typedef struct TclStubs { const TclStubHooks *hooks; int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ - CONST84_RETURN char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ + const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ char * (*tcl_Alloc) (unsigned int size); /* 3 */ void (*tcl_Free) (char *ptr); /* 4 */ @@ -1908,7 +1901,7 @@ typedef struct TclStubs { unsigned char * (*tcl_GetByteArrayFromObj) (Tcl_Obj *objPtr, int *lengthPtr); /* 33 */ int (*tcl_GetDouble) (Tcl_Interp *interp, const char *src, double *doublePtr); /* 34 */ int (*tcl_GetDoubleFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, double *doublePtr); /* 35 */ - int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, CONST84 char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ + int (*tcl_GetIndexFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, const char *const *tablePtr, const char *msg, int flags, int *indexPtr); /* 36 */ int (*tcl_GetInt) (Tcl_Interp *interp, const char *src, int *intPtr); /* 37 */ int (*tcl_GetIntFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int *intPtr); /* 38 */ int (*tcl_GetLongFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, long *longPtr); /* 39 */ @@ -1955,10 +1948,10 @@ typedef struct TclStubs { 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 */ + char * (*tcl_Concat) (int argc, const char *const *argv); /* 83 */ int (*tcl_ConvertElement) (const char *src, char *dst, int flags); /* 84 */ int (*tcl_ConvertCountedElement) (const char *src, int length, char *dst, int flags); /* 85 */ - int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, CONST84 char *const *argv); /* 86 */ + int (*tcl_CreateAlias) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int argc, const char *const *argv); /* 86 */ int (*tcl_CreateAliasObj) (Tcl_Interp *slave, const char *slaveCmd, Tcl_Interp *target, const char *targetCmd, int objc, Tcl_Obj *const objv[]); /* 87 */ 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 */ @@ -1999,8 +1992,8 @@ typedef struct TclStubs { 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 */ + const char * (*tcl_ErrnoId) (void); /* 127 */ + const 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 */ @@ -2020,21 +2013,21 @@ typedef struct TclStubs { Tcl_HashEntry * (*tcl_FirstHashEntry) (Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr); /* 145 */ int (*tcl_Flush) (Tcl_Channel chan); /* 146 */ void (*tcl_FreeResult) (Tcl_Interp *interp); /* 147 */ - int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *argcPtr, CONST84 char ***argvPtr); /* 148 */ - int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, CONST84 char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ + int (*tcl_GetAlias) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *argcPtr, const char ***argvPtr); /* 148 */ + int (*tcl_GetAliasObj) (Tcl_Interp *interp, const char *slaveCmd, Tcl_Interp **targetInterpPtr, const char **targetCmdPtr, int *objcPtr, Tcl_Obj ***objv); /* 149 */ ClientData (*tcl_GetAssocData) (Tcl_Interp *interp, const char *name, Tcl_InterpDeleteProc **procPtr); /* 150 */ Tcl_Channel (*tcl_GetChannel) (Tcl_Interp *interp, const char *chanName, int *modePtr); /* 151 */ int (*tcl_GetChannelBufferSize) (Tcl_Channel chan); /* 152 */ int (*tcl_GetChannelHandle) (Tcl_Channel chan, int direction, ClientData *handlePtr); /* 153 */ ClientData (*tcl_GetChannelInstanceData) (Tcl_Channel chan); /* 154 */ int (*tcl_GetChannelMode) (Tcl_Channel chan); /* 155 */ - CONST84_RETURN char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ + const char * (*tcl_GetChannelName) (Tcl_Channel chan); /* 156 */ int (*tcl_GetChannelOption) (Tcl_Interp *interp, Tcl_Channel chan, const char *optionName, Tcl_DString *dsPtr); /* 157 */ CONST86 Tcl_ChannelType * (*tcl_GetChannelType) (Tcl_Channel chan); /* 158 */ int (*tcl_GetCommandInfo) (Tcl_Interp *interp, const char *cmdName, Tcl_CmdInfo *infoPtr); /* 159 */ - CONST84_RETURN char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ + const char * (*tcl_GetCommandName) (Tcl_Interp *interp, Tcl_Command command); /* 160 */ int (*tcl_GetErrno) (void); /* 161 */ - CONST84_RETURN char * (*tcl_GetHostName) (void); /* 162 */ + const char * (*tcl_GetHostName) (void); /* 162 */ int (*tcl_GetInterpPath) (Tcl_Interp *askInterp, Tcl_Interp *slaveInterp); /* 163 */ Tcl_Interp * (*tcl_GetMaster) (Tcl_Interp *interp); /* 164 */ const char * (*tcl_GetNameOfExecutable) (void); /* 165 */ @@ -2054,9 +2047,9 @@ typedef struct TclStubs { int (*tcl_GetServiceMode) (void); /* 171 */ Tcl_Interp * (*tcl_GetSlave) (Tcl_Interp *interp, const char *slaveName); /* 172 */ Tcl_Channel (*tcl_GetStdChannel) (int type); /* 173 */ - CONST84_RETURN char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ - CONST84_RETURN char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ - CONST84_RETURN char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ + const char * (*tcl_GetStringResult) (Tcl_Interp *interp); /* 174 */ + const char * (*tcl_GetVar) (Tcl_Interp *interp, const char *varName, int flags); /* 175 */ + const char * (*tcl_GetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, int flags); /* 176 */ int (*tcl_GlobalEval) (Tcl_Interp *interp, const char *command); /* 177 */ int (*tcl_GlobalEvalObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 178 */ int (*tcl_HideCommand) (Tcl_Interp *interp, const char *cmdName, const char *hiddenCmdToken); /* 179 */ @@ -2066,25 +2059,25 @@ typedef struct TclStubs { int (*tcl_InputBuffered) (Tcl_Channel chan); /* 183 */ int (*tcl_InterpDeleted) (Tcl_Interp *interp); /* 184 */ int (*tcl_IsSafe) (Tcl_Interp *interp); /* 185 */ - char * (*tcl_JoinPath) (int argc, CONST84 char *const *argv, Tcl_DString *resultPtr); /* 186 */ + char * (*tcl_JoinPath) (int argc, const char *const *argv, Tcl_DString *resultPtr); /* 186 */ int (*tcl_LinkVar) (Tcl_Interp *interp, const char *varName, char *addr, int type); /* 187 */ void (*reserved188)(void); Tcl_Channel (*tcl_MakeFileChannel) (ClientData handle, int mode); /* 189 */ int (*tcl_MakeSafe) (Tcl_Interp *interp); /* 190 */ Tcl_Channel (*tcl_MakeTcpClientChannel) (ClientData tcpSocket); /* 191 */ - char * (*tcl_Merge) (int argc, CONST84 char *const *argv); /* 192 */ + char * (*tcl_Merge) (int argc, const char *const *argv); /* 192 */ Tcl_HashEntry * (*tcl_NextHashEntry) (Tcl_HashSearch *searchPtr); /* 193 */ void (*tcl_NotifyChannel) (Tcl_Channel channel, int mask); /* 194 */ Tcl_Obj * (*tcl_ObjGetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); /* 195 */ Tcl_Obj * (*tcl_ObjSetVar2) (Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, Tcl_Obj *newValuePtr, int flags); /* 196 */ - Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, CONST84 char **argv, int flags); /* 197 */ + Tcl_Channel (*tcl_OpenCommandChannel) (Tcl_Interp *interp, int argc, const char **argv, int flags); /* 197 */ Tcl_Channel (*tcl_OpenFileChannel) (Tcl_Interp *interp, const char *fileName, const char *modeString, int permissions); /* 198 */ Tcl_Channel (*tcl_OpenTcpClient) (Tcl_Interp *interp, int port, const char *address, const char *myaddr, int myport, int async); /* 199 */ Tcl_Channel (*tcl_OpenTcpServer) (Tcl_Interp *interp, int port, const char *host, Tcl_TcpAcceptProc *acceptProc, ClientData callbackData); /* 200 */ void (*tcl_Preserve) (ClientData data); /* 201 */ void (*tcl_PrintDouble) (Tcl_Interp *interp, double value, char *dst); /* 202 */ int (*tcl_PutEnv) (const char *assignment); /* 203 */ - CONST84_RETURN char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ + const char * (*tcl_PosixError) (Tcl_Interp *interp); /* 204 */ void (*tcl_QueueEvent) (Tcl_Event *evPtr, Tcl_QueuePosition position); /* 205 */ int (*tcl_Read) (Tcl_Channel chan, char *bufPtr, int toRead); /* 206 */ void (*tcl_ReapDetachedProcs) (void); /* 207 */ @@ -2095,7 +2088,7 @@ typedef struct TclStubs { Tcl_RegExp (*tcl_RegExpCompile) (Tcl_Interp *interp, const char *pattern); /* 212 */ int (*tcl_RegExpExec) (Tcl_Interp *interp, Tcl_RegExp regexp, const char *text, const char *start); /* 213 */ int (*tcl_RegExpMatch) (Tcl_Interp *interp, const char *text, const char *pattern); /* 214 */ - void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, CONST84 char **startPtr, CONST84 char **endPtr); /* 215 */ + void (*tcl_RegExpRange) (Tcl_RegExp regexp, int index, const char **startPtr, const char **endPtr); /* 215 */ void (*tcl_Release) (ClientData clientData); /* 216 */ void (*tcl_ResetResult) (Tcl_Interp *interp); /* 217 */ int (*tcl_ScanElement) (const char *src, int *flagPtr); /* 218 */ @@ -2117,13 +2110,13 @@ typedef struct TclStubs { void (*tcl_SetObjErrorCode) (Tcl_Interp *interp, Tcl_Obj *errorObjPtr); /* 234 */ void (*tcl_SetObjResult) (Tcl_Interp *interp, Tcl_Obj *resultObjPtr); /* 235 */ void (*tcl_SetStdChannel) (Tcl_Channel channel, int type); /* 236 */ - CONST84_RETURN char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ - CONST84_RETURN char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ - CONST84_RETURN char * (*tcl_SignalId) (int sig); /* 239 */ - CONST84_RETURN char * (*tcl_SignalMsg) (int sig); /* 240 */ + const char * (*tcl_SetVar) (Tcl_Interp *interp, const char *varName, const char *newValue, int flags); /* 237 */ + const char * (*tcl_SetVar2) (Tcl_Interp *interp, const char *part1, const char *part2, const char *newValue, int flags); /* 238 */ + const char * (*tcl_SignalId) (int sig); /* 239 */ + const char * (*tcl_SignalMsg) (int sig); /* 240 */ void (*tcl_SourceRCFile) (Tcl_Interp *interp); /* 241 */ - int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, CONST84 char ***argvPtr); /* 242 */ - void (*tcl_SplitPath) (const char *path, int *argcPtr, CONST84 char ***argvPtr); /* 243 */ + int (*tcl_SplitList) (Tcl_Interp *interp, const char *listStr, int *argcPtr, const char ***argvPtr); /* 242 */ + void (*tcl_SplitPath) (const char *path, int *argcPtr, const char ***argvPtr); /* 243 */ void (*tcl_StaticPackage) (Tcl_Interp *interp, const char *pkgName, Tcl_PackageInitProc *initProc, Tcl_PackageInitProc *safeInitProc); /* 244 */ int (*tcl_StringMatch) (const char *str, const char *pattern); /* 245 */ TCL_DEPRECATED_API("") int (*tcl_TellOld) (Tcl_Channel chan); /* 246 */ @@ -2150,11 +2143,11 @@ typedef struct TclStubs { TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendResultVA) (Tcl_Interp *interp, va_list argList); /* 267 */ TCL_DEPRECATED_API("see TIP #422") void (*tcl_AppendStringsToObjVA) (Tcl_Obj *objPtr, va_list argList); /* 268 */ char * (*tcl_HashStats) (Tcl_HashTable *tablePtr); /* 269 */ - CONST84_RETURN char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, CONST84 char **termPtr); /* 270 */ - CONST84_RETURN char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ - CONST84_RETURN char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ + const char * (*tcl_ParseVar) (Tcl_Interp *interp, const char *start, const char **termPtr); /* 270 */ + const char * (*tcl_PkgPresent) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 271 */ + const char * (*tcl_PkgPresentEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 272 */ int (*tcl_PkgProvide) (Tcl_Interp *interp, const char *name, const char *version); /* 273 */ - CONST84_RETURN char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ + const char * (*tcl_PkgRequire) (Tcl_Interp *interp, const char *name, const char *version, int exact); /* 274 */ TCL_DEPRECATED_API("see TIP #422") void (*tcl_SetErrorCodeVA) (Tcl_Interp *interp, va_list argList); /* 275 */ TCL_DEPRECATED_API("see TIP #422") int (*tcl_VarEvalVA) (Tcl_Interp *interp, va_list argList); /* 276 */ Tcl_Pid (*tcl_WaitPid) (Tcl_Pid pid, int *statPtr, int options); /* 277 */ @@ -2182,7 +2175,7 @@ typedef struct TclStubs { void (*tcl_FreeEncoding) (Tcl_Encoding encoding); /* 299 */ Tcl_ThreadId (*tcl_GetCurrentThread) (void); /* 300 */ Tcl_Encoding (*tcl_GetEncoding) (Tcl_Interp *interp, const char *name); /* 301 */ - CONST84_RETURN char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ + const char * (*tcl_GetEncodingName) (Tcl_Encoding encoding); /* 302 */ void (*tcl_GetEncodingNames) (Tcl_Interp *interp); /* 303 */ int (*tcl_GetIndexFromObjStruct) (Tcl_Interp *interp, Tcl_Obj *objPtr, const void *tablePtr, int offset, const char *msg, int flags, int *indexPtr); /* 304 */ void * (*tcl_GetThreadData) (Tcl_ThreadDataKey *keyPtr, int size); /* 305 */ @@ -2205,13 +2198,13 @@ typedef struct TclStubs { Tcl_UniChar (*tcl_UniCharToTitle) (int ch); /* 322 */ Tcl_UniChar (*tcl_UniCharToUpper) (int ch); /* 323 */ int (*tcl_UniCharToUtf) (int ch, char *buf); /* 324 */ - CONST84_RETURN char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ + const char * (*tcl_UtfAtIndex) (const char *src, int index); /* 325 */ int (*tcl_UtfCharComplete) (const char *src, int length); /* 326 */ int (*tcl_UtfBackslash) (const char *src, int *readPtr, char *dst); /* 327 */ - CONST84_RETURN char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ - CONST84_RETURN char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ - CONST84_RETURN char * (*tcl_UtfNext) (const char *src); /* 330 */ - CONST84_RETURN char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ + const char * (*tcl_UtfFindFirst) (const char *src, int ch); /* 328 */ + const char * (*tcl_UtfFindLast) (const char *src, int ch); /* 329 */ + const char * (*tcl_UtfNext) (const char *src); /* 330 */ + const char * (*tcl_UtfPrev) (const char *src, const char *start); /* 331 */ int (*tcl_UtfToExternal) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 332 */ char * (*tcl_UtfToExternalDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 333 */ int (*tcl_UtfToLower) (char *src); /* 334 */ @@ -2221,7 +2214,7 @@ typedef struct TclStubs { 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_GetEncodingSearchPath") const 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 */ @@ -2240,10 +2233,10 @@ typedef struct TclStubs { 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_ParseBraces) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const 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_ParseQuotedString) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append, const char **termPtr); /* 363 */ int (*tcl_ParseVarName) (Tcl_Interp *interp, const char *start, int numBytes, Tcl_Parse *parsePtr, int append); /* 364 */ char * (*tcl_GetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 365 */ int (*tcl_Chdir) (const char *dirName); /* 366 */ @@ -2278,7 +2271,7 @@ typedef struct TclStubs { int (*tcl_WriteRaw) (Tcl_Channel chan, const char *src, int srcLen); /* 395 */ Tcl_Channel (*tcl_GetTopChannel) (Tcl_Channel chan); /* 396 */ int (*tcl_ChannelBuffered) (Tcl_Channel chan); /* 397 */ - CONST84_RETURN char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ + const char * (*tcl_ChannelName) (const Tcl_ChannelType *chanTypePtr); /* 398 */ Tcl_ChannelTypeVersion (*tcl_ChannelVersion) (const Tcl_ChannelType *chanTypePtr); /* 399 */ Tcl_DriverBlockModeProc * (*tcl_ChannelBlockModeProc) (const Tcl_ChannelType *chanTypePtr); /* 400 */ Tcl_DriverCloseProc * (*tcl_ChannelCloseProc) (const Tcl_ChannelType *chanTypePtr); /* 401 */ diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 33bf0b3..3fe3e8f 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -187,7 +187,7 @@ declare 42 { } # Removed in 8.5a2: #declare 43 { -# int TclGlobalInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int TclGlobalInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 44 { @@ -222,12 +222,12 @@ declare 51 { } # Removed in 8.5a2: #declare 52 { -# int TclInvoke(Tcl_Interp *interp, int argc, CONST84 char **argv, +# int TclInvoke(Tcl_Interp *interp, int argc, const char **argv, # int flags) #} declare 53 { int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, - int argc, CONST84 char **argv) + int argc, const char **argv) } declare 54 { int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, @@ -548,7 +548,7 @@ declare 133 {deprecated {}} { # int TclpChdir(const char *dirName) #} declare 138 { - CONST84_RETURN char *TclGetEnv(const char *name, Tcl_DString *valuePtr) + const char *TclGetEnv(const char *name, Tcl_DString *valuePtr) } #declare 139 { # int TclpLoadFile(Tcl_Interp *interp, char *fileName, char *sym1, @@ -560,7 +560,7 @@ declare 138 { #} # This is used by TclX, but should otherwise be considered private declare 141 { - CONST84_RETURN char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) + const char *TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr) } declare 142 { int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, diff --git a/generic/tclInt.h b/generic/tclInt.h index 8aaa7a8..ecd2924 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -160,13 +160,13 @@ typedef struct Tcl_ResolvedVarInfo { } Tcl_ResolvedVarInfo; typedef int (Tcl_ResolveCompiledVarProc)(Tcl_Interp *interp, - CONST84 char *name, int length, Tcl_Namespace *context, + const char *name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr); -typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, CONST84 char *name, +typedef int (Tcl_ResolveVarProc)(Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr); -typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, CONST84 char *name, +typedef int (Tcl_ResolveCmdProc)(Tcl_Interp *interp, const char *name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr); typedef struct Tcl_ResolverInfo { diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index 22b8072..cd494f4 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -158,7 +158,7 @@ EXTERN int TclInterpInit(Tcl_Interp *interp); /* 53 */ EXTERN int TclInvokeObjectCommand(ClientData clientData, Tcl_Interp *interp, int argc, - CONST84 char **argv); + const char **argv); /* 54 */ EXTERN int TclInvokeStringCommand(ClientData clientData, Tcl_Interp *interp, int objc, @@ -344,13 +344,11 @@ struct tm * TclpGetDate(const time_t *time, int useGMT); /* Slot 136 is reserved */ /* Slot 137 is reserved */ /* 138 */ -EXTERN CONST84_RETURN char * TclGetEnv(const char *name, - Tcl_DString *valuePtr); +EXTERN const char * TclGetEnv(const char *name, Tcl_DString *valuePtr); /* Slot 139 is reserved */ /* Slot 140 is reserved */ /* 141 */ -EXTERN CONST84_RETURN char * TclpGetCwd(Tcl_Interp *interp, - Tcl_DString *cwdPtr); +EXTERN const char * TclpGetCwd(Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 142 */ EXTERN int TclSetByteCodeFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, @@ -692,7 +690,7 @@ typedef struct TclIntStubs { void (*tclInitCompiledLocals) (Tcl_Interp *interp, CallFrame *framePtr, Namespace *nsPtr); /* 50 */ int (*tclInterpInit) (Tcl_Interp *interp); /* 51 */ void (*reserved52)(void); - int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, CONST84 char **argv); /* 53 */ + int (*tclInvokeObjectCommand) (ClientData clientData, Tcl_Interp *interp, int argc, const char **argv); /* 53 */ int (*tclInvokeStringCommand) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); /* 54 */ Proc * (*tclIsProc) (Command *cmdPtr); /* 55 */ void (*reserved56)(void); @@ -777,10 +775,10 @@ typedef struct TclIntStubs { void (*reserved135)(void); void (*reserved136)(void); void (*reserved137)(void); - CONST84_RETURN char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ + const char * (*tclGetEnv) (const char *name, Tcl_DString *valuePtr); /* 138 */ void (*reserved139)(void); void (*reserved140)(void); - CONST84_RETURN char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ + const char * (*tclpGetCwd) (Tcl_Interp *interp, Tcl_DString *cwdPtr); /* 141 */ int (*tclSetByteCodeFromAny) (Tcl_Interp *interp, Tcl_Obj *objPtr, CompileHookProc *hookProc, ClientData clientData); /* 142 */ int (*tclAddLiteralObj) (struct CompileEnv *envPtr, Tcl_Obj *objPtr, LiteralEntry **litPtrPtr); /* 143 */ void (*tclHideLiteral) (Tcl_Interp *interp, struct CompileEnv *envPtr, int index); /* 144 */ -- cgit v0.12 From 011dd7b0f6b3f7eae43f139e2c0b654387718fd8 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Nov 2017 09:13:08 +0000 Subject: Revert [d874801c57]: putting back "string bytelength". It turns out to be too complicated to take along with the other deprecations in TIP #485 --- doc/string.n | 4 ++-- generic/tclCmdMZ.c | 4 ---- library/init.tcl | 4 ++-- tests/info.test | 4 ++-- tests/regexp.test | 4 ++-- tests/regexpComp.test | 4 ++-- 6 files changed, 10 insertions(+), 14 deletions(-) diff --git a/doc/string.n b/doc/string.n index 730f49e..00ce85c 100644 --- a/doc/string.n +++ b/doc/string.n @@ -386,8 +386,8 @@ store the representation is of very low value (except to C extension code, which has direct access for the purpose of memory management, etc.) .PP -\fICompatibility note:\fR this subcommand will be gone in -Tcl 9.0. It is better to use the +\fICompatibility note:\fR it is likely that this subcommand will be +withdrawn in a future version of Tcl. It is better to use the \fBencoding convertto\fR command to convert a string to a known encoding and then apply \fBstring length\fR to that. .PP diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 14ea6ad..67fbc94 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2893,7 +2893,6 @@ StringCatCmd( * *---------------------------------------------------------------------- */ -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 static int StringBytesCmd( ClientData dummy, /* Not used. */ @@ -2912,7 +2911,6 @@ StringBytesCmd( Tcl_SetObjResult(interp, Tcl_NewIntObj(length)); return TCL_OK; } -#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ /* *---------------------------------------------------------------------- @@ -3370,9 +3368,7 @@ TclInitStringCmd( Tcl_Interp *interp) /* Current interpreter. */ { static const EnsembleImplMap stringImplMap[] = { -#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 {"bytelength", StringBytesCmd, TclCompileBasic1ArgCmd, NULL, NULL, 0}, -#endif {"cat", StringCatCmd, TclCompileStringCatCmd, NULL, NULL, 0}, {"compare", StringCmpCmd, TclCompileStringCmpCmd, NULL, NULL, 0}, {"equal", StringEqualCmd, TclCompileStringEqualCmd, NULL, NULL, 0}, diff --git a/library/init.tcl b/library/init.tcl index a3ee05f..13a4300 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -279,9 +279,9 @@ proc unknown args { set errInfo [dict get $opts -errorinfo] set errCode [dict get $opts -errorcode] set cinfo $args - if {[string length $cinfo] > 150} { + if {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 150] - while {[string length $cinfo] > 150} { + while {[string bytelength $cinfo] > 150} { set cinfo [string range $cinfo 0 end-1] } append cinfo ... diff --git a/tests/info.test b/tests/info.test index ac4b98c..fd89b47 100644 --- a/tests/info.test +++ b/tests/info.test @@ -103,8 +103,8 @@ test info-2.5 {info body option, returning bytecompiled bodies} -body { # causing an empty string to be returned [Bug #545644] test info-2.6 {info body option, returning list bodies} { proc foo args [list subst bar] - list [string length [info body foo]] \ - [foo; string length [info body foo]] + list [string bytelength [info body foo]] \ + [foo; string bytelength [info body foo]] } {9 9} proc testinfocmdcount {} { diff --git a/tests/regexp.test b/tests/regexp.test index 62cadd3..7367af7 100644 --- a/tests/regexp.test +++ b/tests/regexp.test @@ -760,8 +760,8 @@ test regexp-20.1 {regsub shared object shimmering} { set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d - list $d [string length $d] -} [list abcdefghijklmnopqurstuvwxyz0123456789 37] + list $d [string length $d] [string bytelength $d] +} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexp-20.2 {regsub shared object shimmering with -about} { eval regexp -about abc } {0 {}} diff --git a/tests/regexpComp.test b/tests/regexpComp.test index dc7b909..fbf8012 100644 --- a/tests/regexpComp.test +++ b/tests/regexpComp.test @@ -798,9 +798,9 @@ test regexpComp-20.1 {regsub shared object shimmering} { set b $a set c abcdefghijklmnopqurstuvwxyz0123456789 regsub $a $c $b d - list $d [string length $d] + list $d [string length $d] [string bytelength $d] } -} [list abcdefghijklmnopqurstuvwxyz0123456789 37] +} [list abcdefghijklmnopqurstuvwxyz0123456789 37 37] test regexpComp-20.2 {regsub shared object shimmering with -about} { evalInProc { eval regexp -about abc -- cgit v0.12 From 119652bd95761672adbaaae020c3c30141104a19 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 21 Nov 2017 09:48:36 +0000 Subject: deprecate VOID/CHAR/SHORT/LONG (windows-only) as well. --- generic/tcl.h | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index e054c19..e85988f 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -299,6 +299,7 @@ extern "C" { * VOID. This block is skipped under Cygwin and Mingw. */ +#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 #if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) #ifndef VOID #define VOID void @@ -314,23 +315,16 @@ typedef long LONG; */ #ifndef __VXWORKS__ -# ifndef NO_VOID -# define VOID void -# else -# define VOID char -# endif +# define VOID void #endif +#endif /* !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9 */ /* * Miscellaneous declarations. */ #ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif + typedef void *ClientData; # define _CLIENTDATA #endif -- cgit v0.12 From 45e646472daf2fe6beb41555fe088b929cd2ce6c Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 11 Jan 2018 15:44:05 +0000 Subject: Fix behavior of Tcl_GetRange() and "string range" regarding surrogates, when Tcl is compiled with -DTCL_UTF_MAX=4. Partial fix for bug [11ae2be95dac9417]. Also, fix typo. --- generic/tclStringObj.c | 13 ++++++++++++- tests/string.test | 4 ++++ 2 files changed, 16 insertions(+), 1 deletion(-) diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 0f238cf..1b35c56 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -533,7 +533,7 @@ Tcl_GetUniChar( * * Get the Unicode form of the String object. If the object is not * already a String object, it will be converted to one. If the String - * object does not have a Unicode rep, then one is create from the UTF + * object does not have a Unicode rep, then one is created from the UTF * string format. * * Results: @@ -667,6 +667,17 @@ Tcl_GetRange( stringPtr = GET_STRING(objPtr); } +#if TCL_UTF_MAX == 4 + /* See: bug [11ae2be95dac9417] */ + if ((first>0) && ((stringPtr->unicode[first]&0xFC00) == 0xDC00) + && ((stringPtr->unicode[first-1]&0xFC00) == 0xD800)) { + ++first; + } + if ((last+1numChars) && ((stringPtr->unicode[last+1]&0xFC00) == 0xDC00) + && ((stringPtr->unicode[last]&0xFC00) == 0xD800)) { + ++last; + } +#endif return Tcl_NewUnicodeObj(stringPtr->unicode + first, last-first+1); } diff --git a/tests/string.test b/tests/string.test index bbba5eb..53f1cfb 100644 --- a/tests/string.test +++ b/tests/string.test @@ -24,6 +24,7 @@ catch [list package require -exact Tcltest [info patchlevel]] testConstraint testobj [expr {[info commands testobj] != {}}] testConstraint testindexobj [expr {[info commands testindexobj] != {}}] +testConstraint fullutf [expr {[format %c 0x010000] != "\ufffd"}] # Used for constraining memory leak tests testConstraint memory [llength [info commands memory]] @@ -1276,6 +1277,9 @@ test string-12.22 {string range, shimmering binary/index} { binary scan $s a* x string range $s $s end } 000000001 +test string-12.23 {string range, surrogates, bug [11ae2be95dac9417]} fullutf { + list [string range a\U100000b 1 1] [string range a\U100000b 2 2] [string range a\U100000b 3 3] +} [list \U100000 {} b] test string-13.1 {string repeat} { list [catch {string repeat} msg] $msg -- cgit v0.12 From 5fea88381c81c486e138059e2c86318935148e8f Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 10:06:30 +0000 Subject: typo's (found by Gustaf Neumann). Thanks! --- generic/tcl.h | 4 ++-- generic/tclInt.h | 12 ++++++------ 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/generic/tcl.h b/generic/tcl.h index b43b2d7..36001ca 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -1986,7 +1986,7 @@ typedef struct Tcl_Token { * TCL_TOKEN_OPERATOR - The token describes one expression operator. * An operator might be the name of a math * function such as "abs". A TCL_TOKEN_OPERATOR - * token is always preceeded by one + * token is always preceded by one * TCL_TOKEN_SUB_EXPR token for the operator's * subexpression, and is followed by zero or more * TCL_TOKEN_SUB_EXPR tokens for the operator's @@ -2622,7 +2622,7 @@ EXTERN void Tcl_GetMemoryInfo(Tcl_DString *dsPtr); #ifndef TCL_NO_DEPRECATED /* * These function have been renamed. The old names are deprecated, but we - * define these macros for backwards compatibilty. + * define these macros for backwards compatibility. */ # define Tcl_Ckalloc Tcl_Alloc diff --git a/generic/tclInt.h b/generic/tclInt.h index 91c8b96..4967cd3 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -413,7 +413,7 @@ struct NamespacePathEntry { */ typedef struct EnsembleConfig { - Namespace *nsPtr; /* The namspace backing this ensemble up. */ + Namespace *nsPtr; /* The namespace backing this ensemble up. */ Tcl_Command token; /* The token for the command that provides * ensemble support for the namespace, or NULL * if the command has been deleted (or never @@ -1813,7 +1813,7 @@ typedef struct Interp { * unused space in interp was repurposed for * pluggable bytecode optimizers. The core * contains one optimizer, which can be - * selectively overriden by extensions. */ + * selectively overridden by extensions. */ } extra; /* @@ -2228,7 +2228,7 @@ typedef struct Interp { * use the rand() or srand() functions. * SAFE_INTERP: Non zero means that the current interp is a safe * interp (i.e. it has only the safe commands installed, - * less priviledge than a regular interp). + * less privilege than a regular interp). * INTERP_DEBUG_FRAME: Used for switching on various extra interpreter * debug/info mechanisms (e.g. info frame eval/uplevel * tracing) which are performance intensive. @@ -2369,7 +2369,7 @@ typedef struct List { * be ignored if there is no string rep at * all.*/ Tcl_Obj *elements; /* First list element; the struct is grown to - * accomodate all elements. */ + * accommodate all elements. */ } List; #define LIST_MAX \ @@ -2491,13 +2491,13 @@ typedef struct List { * tip of the path, so duplication of shared objects should be done along the * way. * - * DICT_PATH_EXISTS indicates that we are performing an existance test and a + * DICT_PATH_EXISTS indicates that we are performing an existence test and a * lookup failure should therefore not be an error. If (and only if) this flag * is set, TclTraceDictPath() will return the special value * DICT_PATH_NON_EXISTENT if the path is not traceable. * * DICT_PATH_CREATE (which also requires the DICT_PATH_UPDATE bit to be set) - * indicates that we are to create non-existant dictionaries on the path. + * indicates that we are to create non-existent dictionaries on the path. */ #define DICT_PATH_READ 0 -- cgit v0.12 From 1c58e29da28ad2a5a2307da0d8384bedc8891040 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 12:56:22 +0000 Subject: Remove Tcl_CaseObjCmd from tclInt.h as well (was missing in previous commit) --- generic/tclCmdMZ.c | 1 + generic/tclInt.h | 5 ----- generic/tclIntPlatDecls.h | 1 - 3 files changed, 1 insertion(+), 6 deletions(-) diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index 1fc2d17..a206cc5 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -2893,6 +2893,7 @@ StringCatCmd( * *---------------------------------------------------------------------- */ + static int StringBytesCmd( ClientData dummy, /* Not used. */ diff --git a/generic/tclInt.h b/generic/tclInt.h index e9b9936..eadcb8e 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3221,11 +3221,6 @@ 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[]); diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h index 437ed24..99d6753 100644 --- a/generic/tclIntPlatDecls.h +++ b/generic/tclIntPlatDecls.h @@ -504,7 +504,6 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -#define TclWinGetPlatformId() (2) /* VER_PLATFORM_WIN32_NT */ #define TclWinConvertWSAError TclWinConvertError #if !defined(_WIN32) -- cgit v0.12 From d695e02d2fd744a4391dcf3c4a8a20e499cc47b1 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 14:17:21 +0000 Subject: Remove obsolete documentation (belonging to now-removed functions). Remove obsolete 8.4 bytecodes. And a few other (internal) macro's which are no longer in use. --- doc/Backslash.3 | 47 --------------- doc/CrtMathFnc.3 | 162 -------------------------------------------------- doc/DString.3 | 6 -- doc/Encoding.3 | 19 +----- doc/ParseCmd.3 | 24 ++------ doc/case.n | 60 ------------------- doc/mathfunc.n | 5 +- generic/tcl.decls | 7 +-- generic/tcl.h | 64 +------------------- generic/tclBasic.c | 12 ---- generic/tclCompile.h | 2 - generic/tclDecls.h | 14 ++--- generic/tclEvent.c | 6 +- generic/tclExecute.c | 143 -------------------------------------------- generic/tclIndexObj.c | 10 ---- generic/tclInt.h | 13 ---- generic/tclPanic.c | 4 +- generic/tclProc.c | 4 -- tests/execute.test | 4 -- tools/genStubs.tcl | 2 - 20 files changed, 24 insertions(+), 584 deletions(-) delete mode 100644 doc/Backslash.3 delete mode 100644 doc/CrtMathFnc.3 delete mode 100644 doc/case.n diff --git a/doc/Backslash.3 b/doc/Backslash.3 deleted file mode 100644 index 0805f8e..0000000 --- a/doc/Backslash.3 +++ /dev/null @@ -1,47 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_Backslash 3 "8.1" Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_Backslash \- parse a backslash sequence -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -char -\fBTcl_Backslash\fR(\fIsrc, countPtr\fR) -.SH ARGUMENTS -.AS char *countPtr out -.AP char *src in -Pointer to a string starting with a backslash. -.AP int *countPtr out -If \fIcountPtr\fR is not NULL, \fI*countPtr\fR gets filled -in with number of characters in the backslash sequence, including -the backslash character. -.BE - -.SH DESCRIPTION -.PP -The use of \fBTcl_Backslash\fR is deprecated in favor of -\fBTcl_UtfBackslash\fR. -.PP -This is a utility procedure provided for backwards compatibility with -non-internationalized Tcl extensions. It parses a backslash sequence and -returns the low byte of the Unicode character corresponding to the sequence. -\fBTcl_Backslash\fR modifies \fI*countPtr\fR to contain the number of -characters in the backslash sequence. -.PP -See the Tcl manual entry for information on the valid backslash sequences. -All of the sequences described in the Tcl manual entry are supported by -\fBTcl_Backslash\fR. -.SH "SEE ALSO" -Tcl(n), Tcl_UtfBackslash(3) - -.SH KEYWORDS -backslash, parse diff --git a/doc/CrtMathFnc.3 b/doc/CrtMathFnc.3 deleted file mode 100644 index acceb5b..0000000 --- a/doc/CrtMathFnc.3 +++ /dev/null @@ -1,162 +0,0 @@ -'\" -'\" Copyright (c) 1989-1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH Tcl_CreateMathFunc 3 8.4 Tcl "Tcl Library Procedures" -.so man.macros -.BS -.SH NAME -Tcl_CreateMathFunc, Tcl_GetMathFuncInfo, Tcl_ListMathFuncs \- Define, query and enumerate math functions for expressions -.SH "NOTICE OF EVENTUAL DEPRECATION" -.PP -The \fBTcl_CreateMathFunc\fR and \fBTcl_GetMathFuncInfo\fR functions -are rendered somewhat obsolete by the ability to create functions for -expressions by placing commands in the \fBtcl::mathfunc\fR namespace, -as described in the \fBmathfunc\fR manual page; the API described on -this page is not expected to be maintained indefinitely. -.SH SYNOPSIS -.nf -\fB#include \fR -.sp -void -\fBTcl_CreateMathFunc\fR(\fIinterp, name, numArgs, argTypes, proc, clientData\fR) -.sp -int -\fBTcl_GetMathFuncInfo\fR(\fIinterp, name, numArgsPtr, argTypesPtr, procPtr, - clientDataPtr\fR) -.sp -Tcl_Obj * -\fBTcl_ListMathFuncs\fR(\fIinterp, pattern\fR) -.SH ARGUMENTS -.AS Tcl_ValueType *clientDataPtr out -.AP Tcl_Interp *interp in -Interpreter in which new function will be defined. -.AP "const char" *name in -Name for new function. -.AP int numArgs in -Number of arguments to new function; also gives size of \fIargTypes\fR array. -.AP Tcl_ValueType *argTypes in -Points to an array giving the permissible types for each argument to -function. -.AP Tcl_MathProc *proc in -Procedure that implements the function. -.AP ClientData clientData in -Arbitrary one-word value to pass to \fIproc\fR when it is invoked. -.AP int *numArgsPtr out -Points to a variable that will be set to contain the number of -arguments to the function. -.AP Tcl_ValueType **argTypesPtr out -Points to a variable that will be set to contain a pointer to an array -giving the permissible types for each argument to the function which -will need to be freed up using \fITcl_Free\fR. -.AP Tcl_MathProc **procPtr out -Points to a variable that will be set to contain a pointer to the -implementation code for the function (or NULL if the function is -implemented directly in bytecode). -.AP ClientData *clientDataPtr out -Points to a variable that will be set to contain the clientData -argument passed to \fITcl_CreateMathFunc\fR when the function was -created if the function is not implemented directly in bytecode. -.AP "const char" *pattern in -Pattern to match against function names so as to filter them (by -passing to \fITcl_StringMatch\fR), or NULL to not apply any filter. -.BE -.SH DESCRIPTION -.PP -Tcl allows a number of mathematical functions to be used in -expressions, such as \fBsin\fR, \fBcos\fR, and \fBhypot\fR. -These functions are represented by commands in the namespace, -\fBtcl::mathfunc\fR. The \fBTcl_CreateMathFunc\fR function is -an obsolete way for applications to add additional functions -to those already provided by Tcl or to replace existing functions. -It should not be used by new applications, which should create -math functions using \fBTcl_CreateObjCommand\fR to create a command -in the \fBtcl::mathfunc\fR namespace. -.PP -In the \fBTcl_CreateMathFunc\fR interface, -\fIName\fR is the name of the function as it will appear in expressions. -If \fIname\fR does not already exist in the \fB::tcl::mathfunc\fR -namespace, then a new command is created in that namespace. -If \fIname\fR does exist, then the existing function is replaced. -\fINumArgs\fR and \fIargTypes\fR describe the arguments to the function. -Each entry in the \fIargTypes\fR array must be -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR, \fBTCL_WIDE_INT\fR, -or \fBTCL_EITHER\fR to indicate whether the corresponding argument must be an -integer, a double-precision floating value, a wide (64-bit) integer, -or any, respectively. -.PP -Whenever the function is invoked in an expression Tcl will invoke -\fIproc\fR. \fIProc\fR should have arguments and result that match -the type \fBTcl_MathProc\fR: -.PP -.CS -typedef int \fBTcl_MathProc\fR( - ClientData \fIclientData\fR, - Tcl_Interp *\fIinterp\fR, - Tcl_Value *\fIargs\fR, - Tcl_Value *\fIresultPtr\fR); -.CE -.PP -When \fIproc\fR is invoked the \fIclientData\fR and \fIinterp\fR -arguments will be the same as those passed to \fBTcl_CreateMathFunc\fR. -\fIArgs\fR will point to an array of \fInumArgs\fR Tcl_Value structures, -which describe the actual arguments to the function: -.PP -.CS -typedef struct Tcl_Value { - Tcl_ValueType \fItype\fR; - long \fIintValue\fR; - double \fIdoubleValue\fR; - Tcl_WideInt \fIwideValue\fR; -} \fBTcl_Value\fR; -.CE -.PP -The \fItype\fR field indicates the type of the argument and is -one of \fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR. -It will match the \fIargTypes\fR value specified for the function unless -the \fIargTypes\fR value was \fBTCL_EITHER\fR. Tcl converts -the argument supplied in the expression to the type requested in -\fIargTypes\fR, if that is necessary. -Depending on the value of the \fItype\fR field, the \fIintValue\fR, -\fIdoubleValue\fR or \fIwideValue\fR -field will contain the actual value of the argument. -.PP -\fIProc\fR should compute its result and store it either as an integer -in \fIresultPtr->intValue\fR or as a floating value in -\fIresultPtr->doubleValue\fR. -It should set also \fIresultPtr->type\fR to one of -\fBTCL_INT\fR, \fBTCL_DOUBLE\fR or \fBTCL_WIDE_INT\fR -to indicate which value was set. -Under normal circumstances \fIproc\fR should return \fBTCL_OK\fR. -If an error occurs while executing the function, \fIproc\fR should -return \fBTCL_ERROR\fR and leave an error message in the interpreter's result. -.PP -\fBTcl_GetMathFuncInfo\fR retrieves the values associated with -function \fIname\fR that were passed to a preceding -\fBTcl_CreateMathFunc\fR call. Normally, the return code is -\fBTCL_OK\fR but if the named function does not exist, \fBTCL_ERROR\fR -is returned and an error message is placed in the interpreter's -result. -.PP -If an error did not occur, the array reference placed in the variable -pointed to by \fIargTypesPtr\fR is newly allocated, and should be -released by passing it to \fBTcl_Free\fR. Some functions (the -standard set implemented in the core, and those defined by placing -commands in the \fBtcl::mathfunc\fR namespace) do not have -argument type information; attempting to retrieve values for -them causes a NULL to be stored in the variable pointed to by -\fIprocPtr\fR and the variable pointed to by \fIclientDataPtr\fR -will not be modified. The variable pointed to by \fInumArgsPointer\fR -will contain -1, and no argument types will be stored in the variable -pointed to by \fIargTypesPointer\fR. -.PP -\fBTcl_ListMathFuncs\fR returns a Tcl value containing a list of all -the math functions defined in the interpreter whose name matches -\fIpattern\fR. The returned value has a reference count of zero. -.SH "SEE ALSO" -expr(n), info(n), Tcl_CreateObjCommand(3), Tcl_Free(3), Tcl_NewListObj(3) -.SH KEYWORDS -expression, mathematical function diff --git a/doc/DString.3 b/doc/DString.3 index 00f1b8a..2828278 100644 --- a/doc/DString.3 +++ b/doc/DString.3 @@ -34,8 +34,6 @@ char * .sp \fBTcl_DStringSetLength\fR(\fIdsPtr, newLength\fR) .sp -\fBTcl_DStringTrunc\fR(\fIdsPtr, newLength\fR) -.sp \fBTcl_DStringFree\fR(\fIdsPtr\fR) .sp \fBTcl_DStringResult\fR(\fIinterp, dsPtr\fR) @@ -128,10 +126,6 @@ caller to fill in the new space. even if the string is truncated to zero length, so \fBTcl_DStringFree\fR will still need to be called. .PP -\fBTcl_DStringTrunc\fR changes the length of a dynamic string. -This procedure is now deprecated. \fBTcl_DStringSetLength\fR should -be used instead. -.PP \fBTcl_DStringFree\fR should be called when you are finished using the string. It frees up any memory that was allocated for the string and reinitializes the string's value to an empty string. diff --git a/doc/Encoding.3 b/doc/Encoding.3 index 79fca0f..40eb614 100644 --- a/doc/Encoding.3 +++ b/doc/Encoding.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath, Tcl_GetDefaultEncodingDir, Tcl_SetDefaultEncodingDir \- procedures for creating and using encodings +Tcl_GetEncoding, Tcl_FreeEncoding, Tcl_GetEncodingFromObj, Tcl_ExternalToUtfDString, Tcl_ExternalToUtf, Tcl_UtfToExternalDString, Tcl_UtfToExternal, Tcl_WinTCharToUtf, Tcl_WinUtfToTChar, Tcl_GetEncodingName, Tcl_SetSystemEncoding, Tcl_GetEncodingNameFromEnvironment, Tcl_GetEncodingNames, Tcl_CreateEncoding, Tcl_GetEncodingSearchPath, Tcl_SetEncodingSearchPath \- procedures for creating and using encodings .SH SYNOPSIS .nf \fB#include \fR @@ -62,12 +62,6 @@ Tcl_Obj * .sp int \fBTcl_SetEncodingSearchPath\fR(\fIsearchPath\fR) -.sp -const char * -\fBTcl_GetDefaultEncodingDir\fR(\fIvoid\fR) -.sp -void -\fBTcl_SetDefaultEncodingDir\fR(\fIpath\fR) .SH ARGUMENTS .AS "const Tcl_EncodingType" *dstWrotePtr in/out .AP Tcl_Interp *interp in @@ -287,7 +281,7 @@ the encoding name to it. The \fBTcl_DStringValue\fR is returned. \fBTcl_GetEncodingNames\fR sets the \fIinterp\fR result to a list consisting of the names of all the encodings that are currently defined or can be dynamically loaded, searching the encoding path specified by -\fBTcl_SetDefaultEncodingDir\fR. This procedure does not ensure that the +\fBTcl_SetEncodingSearchPath\fR. This procedure does not ensure that the dynamically-loadable encoding files contain valid data, but merely that they exist. .PP @@ -402,15 +396,6 @@ are not verified as existing readable filesystem directories. When searching for encoding data files takes place, and non-existent or non-readable filesystem directories on the \fIsearchPath\fR are silently ignored. -.PP -\fBTcl_GetDefaultEncodingDir\fR and \fBTcl_SetDefaultEncodingDir\fR -are obsolete interfaces best replaced with calls to -\fBTcl_GetEncodingSearchPath\fR and \fBTcl_SetEncodingSearchPath\fR. -They are called to access and set the first element of the \fIsearchPath\fR -list. Since Tcl searches \fIsearchPath\fR for encoding data files in -list order, these routines establish the -.QW default -directory in which to find encoding data files. .SH "ENCODING FILES" Space would prohibit precompiling into Tcl every possible encoding algorithm, so many encodings are stored on disk as dynamically-loadable diff --git a/doc/ParseCmd.3 b/doc/ParseCmd.3 index 667d697..01b4065 100644 --- a/doc/ParseCmd.3 +++ b/doc/ParseCmd.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokens, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions +Tcl_ParseCommand, Tcl_ParseExpr, Tcl_ParseBraces, Tcl_ParseQuotedString, Tcl_ParseVarName, Tcl_ParseVar, Tcl_FreeParse, Tcl_EvalTokensStandard \- parse Tcl scripts and expressions .SH SYNOPSIS .nf \fB#include \fR @@ -33,20 +33,16 @@ const char * .sp \fBTcl_FreeParse\fR(\fIusedParsePtr\fR) .sp -Tcl_Obj * -\fBTcl_EvalTokens\fR(\fIinterp, tokenPtr, numTokens\fR) -.sp int \fBTcl_EvalTokensStandard\fR(\fIinterp, tokenPtr, numTokens\fR) .SH ARGUMENTS .AS Tcl_Interp *usedParsePtr out .AP Tcl_Interp *interp out -For procedures other than \fBTcl_FreeParse\fR, \fBTcl_EvalTokens\fR -and \fBTcl_EvalTokensStandard\fR, used only for error reporting; +For procedures other than \fBTcl_FreeParse\fR and +\fBTcl_EvalTokensStandard\fR, used only for error reporting; if NULL, then no error messages are left after errors. -For \fBTcl_EvalTokens\fR and \fBTcl_EvalTokensStandard\fR, -determines the context for evaluating the -script and also is used for error reporting; must not be NULL. +For \fBTcl_EvalTokensStandard\fR, determines the context for evaluating +the script and also is used for error reporting; must not be NULL. .AP "const char" *start in Pointer to first character in string to parse. .AP int numBytes in @@ -191,16 +187,6 @@ code with one of the values \fBTCL_OK\fR, \fBTCL_ERROR\fR, some other integer value originating in an extension. In addition, a result value or error message is left in \fIinterp\fR's result; it can be retrieved using \fBTcl_GetObjResult\fR. -.PP -\fBTcl_EvalTokens\fR differs from \fBTcl_EvalTokensStandard\fR only in -the return convention used: it returns the result in a new Tcl_Obj. -The reference count of the value returned as result has been -incremented, so the caller must -invoke \fBTcl_DecrRefCount\fR when it is finished with the value. -If an error or other exception occurs while evaluating the tokens -(such as a reference to a non-existent variable) then the return value -is NULL and an error message is left in \fIinterp\fR's result. The use -of \fBTcl_EvalTokens\fR is deprecated. .SH "TCL_PARSE STRUCTURE" .PP \fBTcl_ParseCommand\fR, \fBTcl_ParseExpr\fR, \fBTcl_ParseBraces\fR, diff --git a/doc/case.n b/doc/case.n deleted file mode 100644 index c48d634..0000000 --- a/doc/case.n +++ /dev/null @@ -1,60 +0,0 @@ -'\" -'\" Copyright (c) 1993 The Regents of the University of California. -'\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" -'\" See the file "license.terms" for information on usage and redistribution -'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. -'\" -.TH case n 7.0 Tcl "Tcl Built-In Commands" -.so man.macros -.BS -'\" Note: do not modify the .SH NAME line immediately below! -.SH NAME -case \- Evaluate one of several scripts, depending on a given value -.SH SYNOPSIS -\fBcase\fI string \fR?\fBin\fR? \fIpatList body \fR?\fIpatList body \fR...? -.sp -\fBcase\fI string \fR?\fBin\fR? {\fIpatList body \fR?\fIpatList body \fR...?} -.BE - -.SH DESCRIPTION -.PP -\fINote: the \fBcase\fI command is obsolete and is supported only -for backward compatibility. At some point in the future it may be -removed entirely. You should use the \fBswitch\fI command instead.\fR -.PP -The \fBcase\fR command matches \fIstring\fR against each of -the \fIpatList\fR arguments in order. -Each \fIpatList\fR argument is a list of one or -more patterns. If any of these patterns matches \fIstring\fR then -\fBcase\fR evaluates the following \fIbody\fR argument -by passing it recursively to the Tcl interpreter and returns the result -of that evaluation. -Each \fIpatList\fR argument consists of a single -pattern or list of patterns. Each pattern may contain any of the wild-cards -described under \fBstring match\fR. If a \fIpatList\fR -argument is \fBdefault\fR, the corresponding body will be evaluated -if no \fIpatList\fR matches \fIstring\fR. If no \fIpatList\fR argument -matches \fIstring\fR and no default is given, then the \fBcase\fR -command returns an empty string. -.PP -Two syntaxes are provided for the \fIpatList\fR and \fIbody\fR arguments. -The first uses a separate argument for each of the patterns and commands; -this form is convenient if substitutions are desired on some of the -patterns or commands. -The second form places all of the patterns and commands together into -a single argument; the argument must have proper list structure, with -the elements of the list being the patterns and commands. -The second form makes it easy to construct multi-line case commands, -since the braces around the whole list make it unnecessary to include a -backslash at the end of each line. -Since the \fIpatList\fR arguments are in braces in the second form, -no command or variable substitutions are performed on them; this makes -the behavior of the second form different than the first form in some -cases. - -.SH "SEE ALSO" -switch(n) - -.SH KEYWORDS -case, match, regular expression diff --git a/doc/mathfunc.n b/doc/mathfunc.n index 7233d46..ca091c1 100644 --- a/doc/mathfunc.n +++ b/doc/mathfunc.n @@ -106,10 +106,7 @@ of which work solely with floating-point numbers unless otherwise noted: In addition to these predefined functions, applications may define additional functions by using \fBproc\fR (or any other method, such as \fBinterp alias\fR or \fBTcl_CreateObjCommand\fR) to define -new commands in the \fBtcl::mathfunc\fR namespace. In addition, an -obsolete interface named \fBTcl_CreateMathFunc\fR() is available to -extensions that are written in C. The latter interface is not recommended -for new implementations. +new commands in the \fBtcl::mathfunc\fR namespace. .SS "DETAILED DEFINITIONS" .TP \fBabs \fIarg\fR diff --git a/generic/tcl.decls b/generic/tcl.decls index 5a261cb..c1930f6 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -818,7 +818,7 @@ declare 229 { void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr) } declare 230 { - void Tcl_SetPanicProc(TCL_NORETURN1 Tcl_PanicProc *panicProc) + void Tcl_SetPanicProc(TCL_NORETURN Tcl_PanicProc *panicProc) } declare 231 { int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth) @@ -1887,7 +1887,7 @@ declare 518 { # TIP#121 (exit handler) dkf for Joe Mistachkin declare 519 { - Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc) + Tcl_ExitProc *Tcl_SetExitProc(TCL_NORETURN Tcl_ExitProc *proc) } # TIP#143 (resource limits) dkf @@ -2394,9 +2394,6 @@ declare 1 macosx { # Public functions that are not accessible via the stubs table. export { - void Tcl_Main(int argc, char **argv, Tcl_AppInitProc *appInitProc) -} -export { const char *Tcl_InitStubs(Tcl_Interp *interp, const char *version, int exact) } diff --git a/generic/tcl.h b/generic/tcl.h index 3724083..8eb8f49 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -74,7 +74,7 @@ extern "C" { # define JOIN(a,b) JOIN1(a,b) # define JOIN1(a,b) a##b #endif -#endif /* !RC_INVOKED */ +#endif /* RC_INVOKED */ /* * A special definition used to allow this header file to be included from @@ -114,11 +114,6 @@ extern "C" { # define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b))) # define TCL_NORETURN __attribute__ ((noreturn)) # define TCL_NOINLINE __attribute__ ((noinline)) -# if defined(BUILD_tcl) || defined(BUILD_tk) -# define TCL_NORETURN1 __attribute__ ((noreturn)) -# else -# define TCL_NORETURN1 /* nothing */ -# endif #else # define TCL_FORMAT_PRINTF(a,b) # if defined(_MSC_VER) && (_MSC_VER >= 1310) @@ -128,7 +123,6 @@ extern "C" { # define TCL_NORETURN /* nothing */ # define TCL_NOINLINE /* nothing */ # endif -# define TCL_NORETURN1 /* nothing */ #endif /* @@ -233,46 +227,10 @@ extern "C" { #endif /* - *---------------------------------------------------------------------------- - * The following code is copied from winnt.h. If we don't replicate it here, - * then can't be included after tcl.h, since tcl.h also defines - * VOID. This block is skipped under Cygwin and Mingw. - */ - -#if defined(_WIN32) && !defined(HAVE_WINNT_IGNORE_VOID) -#ifndef VOID -#define VOID void -typedef char CHAR; -typedef short SHORT; -typedef long LONG; -#endif -#endif /* _WIN32 && !HAVE_WINNT_IGNORE_VOID */ - -/* - * Macro to use instead of "void" for arguments that must have type "void *" - * in ANSI C; maps them to type "char *" in non-ANSI systems. - */ - -#ifndef __VXWORKS__ -# ifndef NO_VOID -# define VOID void -# else -# define VOID char -# endif -#endif - -/* * Miscellaneous declarations. */ -#ifndef _CLIENTDATA -# ifndef NO_VOID - typedef void *ClientData; -# else - typedef int *ClientData; -# endif -# define _CLIENTDATA -#endif +typedef void *ClientData; /* * Darwin specific configure overrides (to support fat compiles, where @@ -573,22 +531,6 @@ typedef struct stat *Tcl_OldStat_; #define TCL_SUBST_ALL 007 /* - * Argument descriptors for math function callbacks in expressions: - */ - -typedef enum { - TCL_INT, TCL_DOUBLE, TCL_EITHER, TCL_WIDE_INT -} Tcl_ValueType; - -typedef struct Tcl_Value { - Tcl_ValueType type; /* Indicates intValue or doubleValue is valid, - * or both. */ - long intValue; /* Integer value. */ - double doubleValue; /* Double-precision floating value. */ - Tcl_WideInt wideValue; /* Wide (min. 64-bit) integer value. */ -} Tcl_Value; - -/* * Forward declaration of Tcl_Obj to prevent an error when the forward * reference to Tcl_Obj is encountered in the function types declared below. */ @@ -633,8 +575,6 @@ typedef void (Tcl_FreeProc) (char *blockPtr); typedef void (Tcl_IdleProc) (ClientData clientData); typedef void (Tcl_InterpDeleteProc) (ClientData clientData, Tcl_Interp *interp); -typedef int (Tcl_MathProc) (ClientData clientData, Tcl_Interp *interp, - Tcl_Value *args, Tcl_Value *resultPtr); typedef void (Tcl_NamespaceDeleteProc) (ClientData clientData); typedef int (Tcl_ObjCmdProc) (ClientData clientData, Tcl_Interp *interp, int objc, struct Tcl_Obj *const *objv); diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 841dd1f..463e455 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -38,18 +38,6 @@ #endif /* - * The following structure defines the client data for a math function - * registered with Tcl_CreateMathFunc - */ - -typedef struct OldMathFuncData { - Tcl_MathProc *proc; /* Handler function */ - int numArgs; /* Number of args expected */ - Tcl_ValueType *argTypes; /* Types of the args */ - ClientData clientData; /* Client data for the handler function */ -} OldMathFuncData; - -/* * This is the script cancellation struct and hash table. The hash table is * used to keep track of the information necessary to process script * cancellation requests, including the original interp, asynchronous handler diff --git a/generic/tclCompile.h b/generic/tclCompile.h index fcf6d91..2b752ff 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -594,8 +594,6 @@ typedef struct ByteCode { #define INST_UMINUS 59 #define INST_BITNOT 60 #define INST_LNOT 61 -#define INST_CALL_BUILTIN_FUNC1 62 -#define INST_CALL_FUNC1 63 #define INST_TRY_CVT_TO_NUMERIC 64 /* Opcodes 65 to 66 */ diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 3a0db04..ba335ef 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -684,7 +684,7 @@ EXTERN void Tcl_SetErrorCode(Tcl_Interp *interp, ...); EXTERN void Tcl_SetMaxBlockTime(const Tcl_Time *timePtr); /* 230 */ EXTERN void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *panicProc); + TCL_NORETURN Tcl_PanicProc *panicProc); /* 231 */ EXTERN int Tcl_SetRecursionLimit(Tcl_Interp *interp, int depth); /* 232 */ @@ -1469,7 +1469,7 @@ EXTERN void Tcl_GetCommandFullName(Tcl_Interp *interp, EXTERN int Tcl_FSEvalFileEx(Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 519 */ -EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN1 Tcl_ExitProc *proc); +EXTERN Tcl_ExitProc * Tcl_SetExitProc(TCL_NORETURN Tcl_ExitProc *proc); /* 520 */ EXTERN void Tcl_LimitAddHandler(Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, @@ -1804,7 +1804,7 @@ typedef struct TclStubs { int (*tcl_PkgProvideEx) (Tcl_Interp *interp, const char *name, const char *version, const void *clientData); /* 0 */ const char * (*tcl_PkgRequireEx) (Tcl_Interp *interp, const char *name, const char *version, int exact, void *clientDataPtr); /* 1 */ - TCL_NORETURN1 void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ + TCL_NORETURN void (*tcl_Panic) (const char *format, ...) TCL_FORMAT_PRINTF(1, 2); /* 2 */ char * (*tcl_Alloc) (unsigned int size); /* 3 */ void (*tcl_Free) (char *ptr); /* 4 */ char * (*tcl_Realloc) (char *ptr, unsigned int size); /* 5 */ @@ -1951,7 +1951,7 @@ typedef struct TclStubs { int (*tcl_EvalFile) (Tcl_Interp *interp, const char *fileName); /* 130 */ void (*reserved131)(void); void (*tcl_EventuallyFree) (ClientData clientData, Tcl_FreeProc *freeProc); /* 132 */ - TCL_NORETURN1 void (*tcl_Exit) (int status); /* 133 */ + TCL_NORETURN 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 */ @@ -2056,7 +2056,7 @@ typedef struct TclStubs { void (*tcl_SetErrno) (int err); /* 227 */ void (*tcl_SetErrorCode) (Tcl_Interp *interp, ...); /* 228 */ void (*tcl_SetMaxBlockTime) (const Tcl_Time *timePtr); /* 229 */ - void (*tcl_SetPanicProc) (TCL_NORETURN1 Tcl_PanicProc *panicProc); /* 230 */ + void (*tcl_SetPanicProc) (TCL_NORETURN Tcl_PanicProc *panicProc); /* 230 */ int (*tcl_SetRecursionLimit) (Tcl_Interp *interp, int depth); /* 231 */ void (*tcl_SetResult) (Tcl_Interp *interp, char *result, Tcl_FreeProc *freeProc); /* 232 */ int (*tcl_SetServiceMode) (int mode); /* 233 */ @@ -2120,7 +2120,7 @@ typedef struct TclStubs { int (*tcl_EvalEx) (Tcl_Interp *interp, const char *script, int numBytes, int flags); /* 291 */ int (*tcl_EvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags); /* 292 */ int (*tcl_EvalObjEx) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 293 */ - TCL_NORETURN1 void (*tcl_ExitThread) (int status); /* 294 */ + TCL_NORETURN void (*tcl_ExitThread) (int status); /* 294 */ int (*tcl_ExternalToUtf) (Tcl_Interp *interp, Tcl_Encoding encoding, const char *src, int srcLen, int flags, Tcl_EncodingState *statePtr, char *dst, int dstLen, int *srcReadPtr, int *dstWrotePtr, int *dstCharsPtr); /* 295 */ char * (*tcl_ExternalToUtfDString) (Tcl_Encoding encoding, const char *src, int srcLen, Tcl_DString *dsPtr); /* 296 */ void (*tcl_FinalizeThread) (void); /* 297 */ @@ -2345,7 +2345,7 @@ typedef struct TclStubs { Tcl_Command (*tcl_GetCommandFromObj) (Tcl_Interp *interp, Tcl_Obj *objPtr); /* 516 */ void (*tcl_GetCommandFullName) (Tcl_Interp *interp, Tcl_Command command, Tcl_Obj *objPtr); /* 517 */ int (*tcl_FSEvalFileEx) (Tcl_Interp *interp, Tcl_Obj *fileName, const char *encodingName); /* 518 */ - Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN1 Tcl_ExitProc *proc); /* 519 */ + Tcl_ExitProc * (*tcl_SetExitProc) (TCL_NORETURN Tcl_ExitProc *proc); /* 519 */ void (*tcl_LimitAddHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData, Tcl_LimitHandlerDeleteProc *deleteProc); /* 520 */ void (*tcl_LimitRemoveHandler) (Tcl_Interp *interp, int type, Tcl_LimitHandlerProc *handlerProc, ClientData clientData); /* 521 */ int (*tcl_LimitReady) (Tcl_Interp *interp); /* 522 */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 93cf983..f806516 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -89,7 +89,7 @@ static int subsystemsInitialized = 0; * non-NULL value. */ -static TCL_NORETURN1 Tcl_ExitProc *appExitPtr = NULL; +static TCL_NORETURN Tcl_ExitProc *appExitPtr = NULL; typedef struct ThreadSpecificData { ExitHandler *firstExitPtr; /* First in list of all exit handlers for this @@ -857,7 +857,7 @@ Tcl_DeleteThreadExitHandler( Tcl_ExitProc * Tcl_SetExitProc( - TCL_NORETURN1 Tcl_ExitProc *proc) /* New exit handler for app or NULL */ + TCL_NORETURN Tcl_ExitProc *proc) /* New exit handler for app or NULL */ { Tcl_ExitProc *prevExitProc; @@ -938,7 +938,7 @@ Tcl_Exit( int status) /* Exit status for application; typically 0 * for normal return, 1 for error return. */ { - TCL_NORETURN1 Tcl_ExitProc *currentAppExitPtr; + TCL_NORETURN Tcl_ExitProc *currentAppExitPtr; Tcl_MutexLock(&exitMutex); currentAppExitPtr = appExitPtr; diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 935e864..42da922 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -101,64 +101,6 @@ long tclObjsAlloced = 0; long tclObjsFreed = 0; long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 }; #endif /* TCL_COMPILE_STATS */ - -/* - * Support pre-8.5 bytecodes unless specifically requested otherwise. - */ - -#ifndef TCL_SUPPORT_84_BYTECODE -#define TCL_SUPPORT_84_BYTECODE 1 -#endif - -#if TCL_SUPPORT_84_BYTECODE -/* - * We need to know the tclBuiltinFuncTable to support translation of pre-8.5 - * math functions to the namespace-based ::tcl::mathfunc::op in 8.5+. - */ - -typedef struct { - const char *name; /* Name of function. */ - int numArgs; /* Number of arguments for function. */ -} BuiltinFunc; - -/* - * Table describing the built-in math functions. Entries in this table are - * indexed by the values of the INST_CALL_BUILTIN_FUNC instruction's - * operand byte. - */ - -static BuiltinFunc const tclBuiltinFuncTable[] = { - {"acos", 1}, - {"asin", 1}, - {"atan", 1}, - {"atan2", 2}, - {"ceil", 1}, - {"cos", 1}, - {"cosh", 1}, - {"exp", 1}, - {"floor", 1}, - {"fmod", 2}, - {"hypot", 2}, - {"log", 1}, - {"log10", 1}, - {"pow", 2}, - {"sin", 1}, - {"sinh", 1}, - {"sqrt", 1}, - {"tan", 1}, - {"tanh", 1}, - {"abs", 1}, - {"double", 1}, - {"int", 1}, - {"rand", 0}, - {"round", 1}, - {"srand", 1}, - {"wide", 1}, - {NULL, 0}, -}; - -#define LAST_BUILTIN_FUNC 25 -#endif /* * NR_TEBC @@ -2900,91 +2842,6 @@ TEBCresume( return TclNREvalObjv(interp, objc, objv, TCL_EVAL_NOERR | TCL_EVAL_SOURCE_IN_FRAME, NULL); -#if TCL_SUPPORT_84_BYTECODE - case INST_CALL_BUILTIN_FUNC1: - /* - * Call one of the built-in pre-8.5 Tcl math functions. This - * translates to INST_INVOKE_STK1 with the first argument of - * ::tcl::mathfunc::$objv[0]. We need to insert the named math - * function into the stack. - */ - - opnd = TclGetUInt1AtPtr(pc+1); - if ((opnd < 0) || (opnd > LAST_BUILTIN_FUNC)) { - TRACE(("UNRECOGNIZED BUILTIN FUNC CODE %d\n", opnd)); - Tcl_Panic("TclNRExecuteByteCode: unrecognized builtin function code %d", opnd); - } - - TclNewLiteralStringObj(objPtr, "::tcl::mathfunc::"); - Tcl_AppendToObj(objPtr, tclBuiltinFuncTable[opnd].name, -1); - - /* - * Only 0, 1 or 2 args. - */ - - { - int numArgs = tclBuiltinFuncTable[opnd].numArgs; - Tcl_Obj *tmpPtr1, *tmpPtr2; - - if (numArgs == 0) { - PUSH_OBJECT(objPtr); - } else if (numArgs == 1) { - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - Tcl_DecrRefCount(tmpPtr1); - } else { - tmpPtr2 = POP_OBJECT(); - tmpPtr1 = POP_OBJECT(); - PUSH_OBJECT(objPtr); - PUSH_OBJECT(tmpPtr1); - PUSH_OBJECT(tmpPtr2); - Tcl_DecrRefCount(tmpPtr1); - Tcl_DecrRefCount(tmpPtr2); - } - objc = numArgs + 1; - } - pcAdjustment = 2; - goto doInvocation; - - case INST_CALL_FUNC1: - /* - * Call a non-builtin Tcl math function previously registered by a - * call to Tcl_CreateMathFunc pre-8.5. This is essentially - * INST_INVOKE_STK1 converting the first arg to - * ::tcl::mathfunc::$objv[0]. - */ - - objc = TclGetUInt1AtPtr(pc+1); /* Number of arguments. The function - * name is the 0-th argument. */ - - objPtr = OBJ_AT_DEPTH(objc-1); - TclNewLiteralStringObj(tmpPtr, "::tcl::mathfunc::"); - Tcl_AppendObjToObj(tmpPtr, objPtr); - Tcl_DecrRefCount(objPtr); - - /* - * Variation of PUSH_OBJECT. - */ - - OBJ_AT_DEPTH(objc-1) = tmpPtr; - Tcl_IncrRefCount(tmpPtr); - - pcAdjustment = 2; - goto doInvocation; -#else - /* - * INST_CALL_BUILTIN_FUNC1 and INST_CALL_FUNC1 were made obsolete by the - * changes to add a ::tcl::mathfunc namespace in 8.5. Optional support - * remains for existing bytecode precompiled files. - */ - - case INST_CALL_BUILTIN_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_BUILTIN_FUNC1 found"); - case INST_CALL_FUNC1: - Tcl_Panic("TclNRExecuteByteCode: obsolete INST_CALL_FUNC1 found"); -#endif - case INST_INVOKE_REPLACE: objc = TclGetUInt4AtPtr(pc+1); opnd = TclGetUInt1AtPtr(pc+5); diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index eeed0e5..ce6ab68 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -891,18 +891,8 @@ Tcl_WrongNumArgs( * future... */ -#ifndef AVOID_HACKS_FOR_ITCL - int isFirst = 1; /* Special flag used to inhibit the treating - * of the first word as a list element so the - * hacky way Itcl generates error messages for - * its ensembles will still work. [Bug - * 1066837] */ -# define MAY_QUOTE_WORD (!isFirst) -# define AFTER_FIRST_WORD (isFirst = 0) -#else /* !AVOID_HACKS_FOR_ITCL */ # define MAY_QUOTE_WORD 1 # define AFTER_FIRST_WORD (void) 0 -#endif /* AVOID_HACKS_FOR_ITCL */ TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { diff --git a/generic/tclInt.h b/generic/tclInt.h index eadcb8e..fe7b93d 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -26,19 +26,6 @@ #undef ACCEPT_NAN /* - * In Tcl 8.7, stop supporting special hacks for legacy Itcl 3. - * Itcl 4 doesn't need them. Itcl 3 can be updated to not need them - * using the Tcl(Init|Reset)RewriteEnsemble() routines in all Tcl 8.6+ - * releases. Perhaps Tcl 8.7 will add even better public interfaces - * supporting all the re-invocation mechanisms extensions like Itcl 3 - * need. As an absolute last resort, folks who must make Itcl 3 work - * unchanged with Tcl 8.7 can remove this line to regain the migration - * support. Tcl 9 will no longer offer even that option. - */ - -#define AVOID_HACKS_FOR_ITCL 1 - -/* * Common include files needed by most of the Tcl source files are included * here, so that system-dependent personalizations for the include files only * have to be made in once place. This results in a few extra includes, but diff --git a/generic/tclPanic.c b/generic/tclPanic.c index 78ccf7c..c9ccf8a 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -26,7 +26,7 @@ #if defined(__CYGWIN__) static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic; #else -static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; +static TCL_NORETURN Tcl_PanicProc *panicProc = NULL; #endif /* @@ -47,7 +47,7 @@ static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL; void Tcl_SetPanicProc( - TCL_NORETURN1 Tcl_PanicProc *proc) + TCL_NORETURN Tcl_PanicProc *proc) { #if defined(_WIN32) /* tclWinDebugPanic only installs if there is no panicProc yet. */ diff --git a/generic/tclProc.c b/generic/tclProc.c index 70dc4dc..f5b3a64 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1051,11 +1051,7 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { -#ifdef AVOID_HACKS_FOR_ITCL - desiredObjs[0] = framePtr->objv[skip-1]; -#else desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); -#endif /* AVOID_HACKS_FOR_ITCL */ } Tcl_IncrRefCount(desiredObjs[0]); diff --git a/tests/execute.test b/tests/execute.test index 7bd2601..91a7de2 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -459,10 +459,6 @@ test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} { list [catch {expr {! $x}} msg] $msg } {1 {can't use non-numeric string "foo" as operand of "!"}} -# INST_BITNOT not tested -# INST_CALL_BUILTIN_FUNC1 not tested -# INST_CALL_FUNC1 not tested - # INST_TRY_CVT_TO_NUMERIC is partially tested: test execute-3.72 {TclExecuteByteCode, INST_TRY_CVT_TO_NUMERIC, op is int} {testobj} { set x [testintobj set 1 1] diff --git a/tools/genStubs.tcl b/tools/genStubs.tcl index 830ba2b..a345437 100644 --- a/tools/genStubs.tcl +++ b/tools/genStubs.tcl @@ -600,8 +600,6 @@ proc genStubs::makeSlot {name decl index} { } if {[string range $rtype end-8 end] eq "__stdcall"} { append text [string trim [string range $rtype 0 end-9]] " (__stdcall *" $lfname ") " - } elseif {[string range $rtype 0 11] eq "TCL_NORETURN"} { - append text "TCL_NORETURN1 " [string trim [string range $rtype 12 end]] " (*" $lfname ") " } else { append text $rtype " (*" $lfname ") " } -- cgit v0.12 From 4786f9814b9d6bf0d105c2c0a38082df4c26296e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 17 Jan 2018 16:01:42 +0000 Subject: clean-up some more remainings of the Itcl hack. Taken over from "novem". --- generic/tclIndexObj.c | 23 ++--------------------- generic/tclProc.c | 4 ++-- 2 files changed, 4 insertions(+), 23 deletions(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index ce6ab68..bb329ad 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -881,19 +881,6 @@ Tcl_WrongNumArgs( Interp *iPtr = (Interp *) interp; const char *elementStr; - /* - * [incr Tcl] does something fairly horrific when generating error - * messages for its ensembles; it passes the whole set of ensemble - * arguments as a list in the first argument. This means that this code - * causes a problem in iTcl if it attempts to correctly quote all - * arguments, which would be the correct thing to do. We work around this - * nasty behaviour for now, and hope that we can remove it all in the - * future... - */ - -# define MAY_QUOTE_WORD 1 -# define AFTER_FIRST_WORD (void) 0 - TclNewObj(objPtr); if (iPtr->flags & INTERP_ALTERNATE_WRONG_ARGS) { iPtr->flags &= ~INTERP_ALTERNATE_WRONG_ARGS; @@ -960,7 +947,7 @@ Tcl_WrongNumArgs( flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { + if (len != elemLen) { char *quotedElementStr = TclStackAlloc(interp, (unsigned)len + 1); @@ -972,8 +959,6 @@ Tcl_WrongNumArgs( Tcl_AppendToObj(objPtr, elementStr, elemLen); } - AFTER_FIRST_WORD; - /* * Add a space if the word is not the last one (which has a * moderately complex condition here). @@ -1011,7 +996,7 @@ Tcl_WrongNumArgs( flags = 0; len = TclScanElement(elementStr, elemLen, &flags); - if (MAY_QUOTE_WORD && len != elemLen) { + if (len != elemLen) { char *quotedElementStr = TclStackAlloc(interp, (unsigned) len + 1); @@ -1024,8 +1009,6 @@ Tcl_WrongNumArgs( } } - AFTER_FIRST_WORD; - /* * Append a space character (" ") if there is more text to follow * (either another element from objv, or the message string). @@ -1048,8 +1031,6 @@ Tcl_WrongNumArgs( Tcl_AppendStringsToObj(objPtr, "\"", NULL); Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", NULL); Tcl_SetObjResult(interp, objPtr); -#undef MAY_QUOTE_WORD -#undef AFTER_FIRST_WORD } /* diff --git a/generic/tclProc.c b/generic/tclProc.c index f5b3a64..da729ef 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -1051,7 +1051,7 @@ ProcWrongNumArgs( if (framePtr->isProcCallFrame & FRAME_IS_LAMBDA) { desiredObjs[0] = Tcl_NewStringObj("lambdaExpr", -1); } else { - desiredObjs[0] = Tcl_NewListObj(1, framePtr->objv + skip - 1); + desiredObjs[0] = framePtr->objv[skip-1]; } Tcl_IncrRefCount(desiredObjs[0]); @@ -1310,7 +1310,7 @@ InitLocalCache( *namePtr = NULL; } else { *namePtr = TclCreateLiteral(iPtr, localPtr->name, - localPtr->nameLength, /* hash */ (unsigned int) -1, + localPtr->nameLength, /* hash */ -1, &new, /* nsPtr */ NULL, 0, NULL); Tcl_IncrRefCount(*namePtr); } -- cgit v0.12 From eb5da6ae825ef4d30e2d0c2caff0055ca60bb05c Mon Sep 17 00:00:00 2001 From: stu Date: Wed, 17 Jan 2018 19:01:03 +0000 Subject: OpenBSD now has AI_ADDRCONFIG. --- generic/tclIOSock.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 6abfa60..24c26f6 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -223,7 +223,7 @@ TclCreateSocketAddress( * using AI_ADDRCONFIG is probably low even in situations where it works, * we'll leave it out for now. After all, it is just an optimisation. * - * Missing on: OpenBSD, NetBSD. + * Missing on NetBSD. * Causes failure when used on AIX 5.1 and HP-UX */ -- cgit v0.12