diff options
| -rw-r--r-- | generic/tclBasic.c | 7 | ||||
| -rw-r--r-- | generic/tclDecls.h | 50 | ||||
| -rw-r--r-- | generic/tclEncoding.c | 5 | ||||
| -rw-r--r-- | generic/tclIO.c | 53 | ||||
| -rw-r--r-- | generic/tclIOCmd.c | 6 | ||||
| -rw-r--r-- | generic/tclIntDecls.h | 3 | ||||
| -rw-r--r-- | generic/tclStubInit.c | 58 | ||||
| -rw-r--r-- | generic/tclTest.c | 11 | ||||
| -rw-r--r-- | generic/tclUtil.c | 3 | ||||
| -rw-r--r-- | tests/encoding.test | 12 | ||||
| -rw-r--r-- | tests/unixInit.test | 7 | ||||
| -rw-r--r-- | unix/tclUnixTest.c | 73 | ||||
| -rw-r--r-- | win/Makefile.in | 7 |
13 files changed, 138 insertions, 157 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 4d5b715..dc0875c 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -45,12 +45,14 @@ * registered with Tcl_CreateMathFunc */ +#ifndef TCL_NO_DEPRECATED 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; +#endif /* * This is the script cancellation struct and hash table. The hash table is @@ -136,8 +138,10 @@ static Tcl_NRPostProc NRCoroutineExitCallback; static int NRCommand(ClientData data[], Tcl_Interp *interp, int result); static Tcl_NRPostProc NRRunObjProc; +#ifndef TCL_NO_DEPRECATED static Tcl_ObjCmdProc OldMathFuncProc; static void OldMathFuncDeleteProc(ClientData clientData); +#endif static void ProcessUnexpectedResult(Tcl_Interp *interp, int returnCode); static int RewindCoroutine(CoroutineData *corPtr, int result); @@ -3445,7 +3449,7 @@ TclCleanupCommand( * *---------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED void Tcl_CreateMathFunc( Tcl_Interp *interp, /* Interpreter in which function is to be @@ -3777,6 +3781,7 @@ Tcl_ListMathFuncs( return result; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tclDecls.h b/generic/tclDecls.h index d931873..ac55ab3 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -3806,6 +3806,56 @@ extern const TclStubs *tclStubsPtr; #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT +#undef Tcl_SeekOld +#undef Tcl_TellOld + +#ifdef TCL_NO_DEPRECATED +# undef Tcl_CreateMathFunc +# undef Tcl_GetMathFuncInfo +# undef Tcl_ListMathFuncs +# undef Tcl_Backslash +# undef Tcl_GetDefaultEncodingDir +# undef Tcl_SetDefaultEncodingDir +# undef Tcl_PkgPresent +# define Tcl_PkgPresent(interp, name, version, exact) \ + Tcl_PkgPresentEx(interp, name, version, exact, NULL) +# undef Tcl_PkgProvide +# define Tcl_PkgProvide(interp, name, version) \ + Tcl_PkgProvideEx(interp, name, version, NULL) +# undef Tcl_PkgRequire +# define Tcl_PkgRequire(interp, name, version, exact) \ + Tcl_PkgRequireEx(interp, name, version, exact, NULL) +# undef Tcl_Eval +# define Tcl_Eval(interp,objPtr) \ + Tcl_EvalEx((interp),(objPtr),-1,0) +# undef Tcl_GlobalEval +# define Tcl_GlobalEval(interp,objPtr) \ + Tcl_EvalEx((interp),(objPtr),-1,TCL_EVAL_GLOBAL) +# undef Tcl_GetIndexFromObj +# define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \ + Tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), \ + sizeof(char *), (msg), (flags), (indexPtr)) +# undef Tcl_NewIntObj +# define Tcl_NewIntObj Tcl_NewLongObj +# undef Tcl_SetIntObj +# define Tcl_SetIntObj Tcl_SetLongObj +# undef Tcl_NewBooleanObj +# define Tcl_NewBooleanObj(boolValue) \ + Tcl_NewLongObj((boolValue)!=0) +# undef Tcl_DbNewBooleanObj +# define Tcl_DbNewBooleanObj(boolValue, file, line) \ + Tcl_DbNewLongObj((boolValue)!=0, file, line) +# undef Tcl_SetBooleanObj +# define Tcl_SetBooleanObj(objPtr, boolValue) \ + Tcl_SetLongObj((objPtr), (boolValue)!=0) +# undef Tcl_AddErrorInfo +# define Tcl_AddErrorInfo(interp, message) \ + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), -1)) +# undef Tcl_AddObjErrorInfo +# define Tcl_AddObjErrorInfo(interp, message, length) \ + Tcl_AppendObjToErrorInfo((interp), Tcl_NewStringObj((message), length)) +#endif + /* * Deprecated Tcl procedures: */ diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 2cc55d6..084966a 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -686,7 +686,7 @@ TclFinalizeEncodingSubsystem(void) * *------------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED const char * Tcl_GetDefaultEncodingDir(void) { @@ -701,6 +701,7 @@ Tcl_GetDefaultEncodingDir(void) return Tcl_GetString(first); } +#endif /* TCL_NO_DEPRECATED */ /* *------------------------------------------------------------------------- @@ -719,6 +720,7 @@ Tcl_GetDefaultEncodingDir(void) *------------------------------------------------------------------------- */ +#ifndef TCL_NO_DEPRECATED void Tcl_SetDefaultEncodingDir( const char *path) @@ -730,6 +732,7 @@ Tcl_SetDefaultEncodingDir( Tcl_ListObjReplace(NULL, searchPath, 0, 0, 1, &directory); Tcl_SetEncodingSearchPath(searchPath); } +#endif /* TCL_NO_DEPRECATED */ /* *------------------------------------------------------------------------- diff --git a/generic/tclIO.c b/generic/tclIO.c index f340d59..ae3cfac 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -7059,47 +7059,6 @@ Tcl_Tell( /* *--------------------------------------------------------------------------- * - * Tcl_SeekOld, Tcl_TellOld -- - * - * Backward-compatability versions of the seek/tell interface that do not - * support 64-bit offsets. This interface is not documented or expected - * to be supported indefinitely. - * - * Results: - * As for Tcl_Seek and Tcl_Tell respectively, except truncated to - * whatever value will fit in an 'int'. - * - * Side effects: - * As for Tcl_Seek and Tcl_Tell respectively. - * - *--------------------------------------------------------------------------- - */ - -int -Tcl_SeekOld( - Tcl_Channel chan, /* The channel on which to seek. */ - int offset, /* Offset to seek to. */ - int mode) /* Relative to which location to seek? */ -{ - Tcl_WideInt wOffset, wResult; - - wOffset = Tcl_LongAsWide((long) offset); - wResult = Tcl_Seek(chan, wOffset, mode); - return (int) Tcl_WideAsLong(wResult); -} - -int -Tcl_TellOld( - Tcl_Channel chan) /* The channel to return pos for. */ -{ - Tcl_WideInt wResult = Tcl_Tell(chan); - - return (int) Tcl_WideAsLong(wResult); -} - -/* - *--------------------------------------------------------------------------- - * * Tcl_TruncateChannel -- * * Truncate a channel to the given length. @@ -9006,18 +8965,6 @@ ZeroTransferTimerProc( */ int -TclCopyChannelOld( - Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Channel inChan, /* Channel to read from. */ - Tcl_Channel outChan, /* Channel to write to. */ - int toRead, /* Amount of data to copy, or -1 for all. */ - Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ -{ - return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, - cmdPtr); -} - -int TclCopyChannel( Tcl_Interp *interp, /* Current interpreter. */ Tcl_Channel inChan, /* Channel to read from. */ diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index 1673bce..4d135e5 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -139,7 +139,7 @@ Tcl_PutsObjCmd( chanObjPtr = objv[2]; string = objv[3]; break; -#if TCL_MAJOR_VERSION < 9 +#ifndef TCL_NO_DEPRECATED } else if (strcmp(TclGetString(objv[3]), "nonewline") == 0) { /* * The code below provides backwards compatibility with an old @@ -429,7 +429,7 @@ Tcl_ReadObjCmd( if (i < objc) { if ((TclGetIntFromObj(interp, objv[i], &toRead) != TCL_OK) || (toRead < 0)) { -#if TCL_MAJOR_VERSION < 9 +#ifndef TCL_NO_DEPRECATED /* * The code below provides backwards compatibility with an old * form of the command that is no longer recommended or @@ -444,7 +444,7 @@ Tcl_ReadObjCmd( TclGetString(objv[i]))); Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL); return TCL_ERROR; -#if TCL_MAJOR_VERSION < 9 +#ifndef TCL_NO_DEPRECATED } newline = 1; #endif diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index cf88e5f..533d6f4 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -1356,4 +1356,7 @@ extern const TclIntStubs *tclIntStubsPtr; (tclStubsPtr->tcl_GetCommandFullName) /* 517 */ #endif +#undef TclCopyChannelOld +#undef TclSockMinimumBuffersOld + #endif /* _TCLINTDECLS */ diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 1dbdc09..9ebf61f 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -43,16 +43,66 @@ #undef TclSockMinimumBuffers #define TclBackgroundException Tcl_BackgroundException -/* See bug 510001: TclSockMinimumBuffers needs plat imp */ -#ifdef _WIN64 +#ifdef TCL_NO_DEPRECATED +# define Tcl_CreateMathFunc 0 +# define Tcl_GetMathFuncInfo 0 +# define Tcl_ListMathFuncs 0 +# define TclCopyChannelOld 0 # define TclSockMinimumBuffersOld 0 +# define Tcl_SeekOld 0 +# define Tcl_TellOld 0 +# define Tcl_Backslash 0 +# define Tcl_GetDefaultEncodingDir 0 +# define Tcl_SetDefaultEncodingDir 0 #else -#define TclSockMinimumBuffersOld sockMinimumBuffersOld + +/* See bug 510001: TclSockMinimumBuffers needs plat imp */ +# ifdef _WIN64 +# define TclSockMinimumBuffersOld 0 +# else +# define TclSockMinimumBuffersOld sockMinimumBuffersOld static int TclSockMinimumBuffersOld(int sock, int size) { return TclSockMinimumBuffers(INT2PTR(sock), size); } -#endif +# endif + +# define TclCopyChannelOld copyChannelOld +static int +TclCopyChannelOld( + Tcl_Interp *interp, /* Current interpreter. */ + Tcl_Channel inChan, /* Channel to read from. */ + Tcl_Channel outChan, /* Channel to write to. */ + int toRead, /* Amount of data to copy, or -1 for all. */ + Tcl_Obj *cmdPtr) /* Pointer to script to execute or NULL. */ +{ + return TclCopyChannel(interp, inChan, outChan, (Tcl_WideInt) toRead, + cmdPtr); +} + +#define Tcl_SeekOld seekOld +static int +Tcl_SeekOld( + Tcl_Channel chan, /* The channel on which to seek. */ + int offset, /* Offset to seek to. */ + int mode) /* Relative to which location to seek? */ +{ + Tcl_WideInt wOffset, wResult; + wOffset = Tcl_LongAsWide((long) offset); + wResult = Tcl_Seek(chan, wOffset, mode); + return (int) Tcl_WideAsLong(wResult); +} + +#define Tcl_TellOld tellOld +static int +Tcl_TellOld( + Tcl_Channel chan) /* The channel to return pos for. */ +{ + Tcl_WideInt wResult = Tcl_Tell(chan); + return (int) Tcl_WideAsLong(wResult); +} + +#endif /* TCL_NO_DEPRECATED */ #define TclSetStartupScriptPath setStartupScriptPath static void TclSetStartupScriptPath(Tcl_Obj *path) diff --git a/generic/tclTest.c b/generic/tclTest.c index a8b27fb..87defd5 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -294,12 +294,14 @@ 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, @@ -523,7 +525,9 @@ 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; @@ -665,8 +669,10 @@ 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, @@ -677,10 +683,12 @@ 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_CreateObjCommand(interp, "testnrelevels", TestNRELevels, NULL, NULL); @@ -3315,7 +3323,7 @@ TestlocaleCmd( * *---------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED /* ARGSUSED */ static int TestMathFunc( @@ -3436,6 +3444,7 @@ TestMathFunc2( } return result; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 27e2474..247c4f6 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -1571,7 +1571,7 @@ Tcl_Merge( * *---------------------------------------------------------------------- */ - +#ifndef TCL_NO_DEPRECATED char Tcl_Backslash( const char *src, /* Points to the backslash character of a @@ -1586,6 +1586,7 @@ Tcl_Backslash( TclUtfToUniChar(buf, &ch); return (char) ch; } +#endif /* TCL_NO_DEPRECATED */ /* *---------------------------------------------------------------------- diff --git a/tests/encoding.test b/tests/encoding.test index 0374e2d..687887b 100644 --- a/tests/encoding.test +++ b/tests/encoding.test @@ -35,7 +35,6 @@ proc runtests {} { # Some tests require the testencoding command testConstraint testencoding [llength [info commands testencoding]] testConstraint exec [llength [info commands exec]] -testConstraint testgetdefenc [llength [info commands testgetdefenc]] # TclInitEncodingSubsystem is tested by the rest of this file # TclFinalizeEncodingSubsystem is not currently tested @@ -570,17 +569,6 @@ foreach from {cp932 shiftjis euc-jp iso2022-jp} { } } -test encoding-26.0 {Tcl_GetDefaultEncodingDir} -constraints { - testgetdefenc -} -setup { - set origDir [testgetdefenc] - testsetdefenc slappy -} -body { - testgetdefenc -} -cleanup { - testsetdefenc $origDir -} -result slappy - file delete {*}[glob -directory [temporaryDirectory] *.chars *.tcltestout] # ===> Cut here <=== diff --git a/tests/unixInit.test b/tests/unixInit.test index 05338ed..9e59150 100644 --- a/tests/unixInit.test +++ b/tests/unixInit.test @@ -87,13 +87,6 @@ test unixInit-1.2 {initialisation: standard channel type deduction} {unix stdio} skip [concat [skip] unixInit-2.*] -test unixInit-2.0 {TclpInitLibraryPath: setting tclDefaultEncodingDir} { - set origDir [testgetdefenc] - testsetdefenc slappy - set path [testgetdefenc] - testsetdefenc $origDir - set path -} {slappy} test unixInit-2.1 {TclpInitLibraryPath: value of installLib, developLib} -setup { unset -nocomplain oldlibrary if {[info exists env(TCL_LIBRARY)]} { diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index c10225d..de62f52 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -67,10 +67,8 @@ static Tcl_CmdProc TestchmodCmd; static Tcl_CmdProc TestfilehandlerCmd; static Tcl_CmdProc TestfilewaitCmd; static Tcl_CmdProc TestfindexecutableCmd; -static Tcl_CmdProc TestgetdefencdirCmd; static Tcl_CmdProc TestgetopenfileCmd; static Tcl_CmdProc TestgotsigCmd; -static Tcl_CmdProc TestsetdefencdirCmd; static Tcl_FileProc TestFileHandlerProc; static void AlarmHandler(int signum); @@ -105,10 +103,6 @@ TclplatformtestInit( NULL, NULL); Tcl_CreateCommand(interp, "testgetopenfile", TestgetopenfileCmd, NULL, NULL); - Tcl_CreateCommand(interp, "testgetdefenc", TestgetdefencdirCmd, - NULL, NULL); - Tcl_CreateCommand(interp, "testsetdefenc", TestsetdefencdirCmd, - NULL, NULL); Tcl_CreateCommand(interp, "testalarm", TestalarmCmd, NULL, NULL); Tcl_CreateCommand(interp, "testgotsig", TestgotsigCmd, @@ -496,73 +490,6 @@ TestgetopenfileCmd( /* *---------------------------------------------------------------------- * - * TestsetdefencdirCmd -- - * - * This function implements the "testsetdefenc" command. It is used to - * test Tcl_SetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestsetdefencdirCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - if (argc != 2) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], - " defaultDir\"", NULL); - return TCL_ERROR; - } - - Tcl_SetDefaultEncodingDir(argv[1]); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * - * TestgetdefencdirCmd -- - * - * This function implements the "testgetdefenc" command. It is used to - * test Tcl_GetDefaultEncodingDir(). - * - * Results: - * A standard Tcl result. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static int -TestgetdefencdirCmd( - ClientData clientData, /* Not used. */ - Tcl_Interp *interp, /* Current interpreter. */ - int argc, /* Number of arguments. */ - const char **argv) /* Argument strings. */ -{ - if (argc != 1) { - Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], NULL); - return TCL_ERROR; - } - - Tcl_AppendResult(interp, Tcl_GetDefaultEncodingDir(), NULL); - return TCL_OK; -} - -/* - *---------------------------------------------------------------------- - * * TestalarmCmd -- * * Test that EINTR is handled correctly by generating and handling a diff --git a/win/Makefile.in b/win/Makefile.in index 99009b9..cc399a4 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -93,6 +93,11 @@ COMPILE_DEBUG_FLAGS = #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG #COMPILE_DEBUG_FLAGS = -DTCL_COMPILE_DEBUG -DTCL_COMPILE_STATS +# To compile without backward compatibility and deprecated code uncomment the +# following +NO_DEPRECATED_FLAGS = +#NO_DEPRECATED_FLAGS = -DTCL_NO_DEPRECATED + SRC_DIR = @srcdir@ ROOT_DIR = @srcdir@/.. TOP_DIR = $(shell cd @srcdir@/..; pwd -P) @@ -200,7 +205,7 @@ CC_EXENAME = @CC_EXENAME@ STUB_CC_SWITCHES = ${CFLAGS} ${CFLAGS_WARNING} ${SHLIB_CFLAGS} \ -I"${GENERIC_DIR_NATIVE}" -DTCL_TOMMATH -DMP_PREC=4 -I"${TOMMATH_DIR_NATIVE}" \ -I"${WIN_DIR_NATIVE}" ${AC_FLAGS} \ -${COMPILE_DEBUG_FLAGS} +${COMPILE_DEBUG_FLAGS} ${NO_DEPRECATED_FLAGS} TCLTEST_OBJS = \ tclTest.$(OBJEXT) \ |