merge trunk

<p>compiling with -DTCL_NO_DEPRECATED will removes those functions from the stub table as well.

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 */
 
 /*
  *----------------------------------------------------------------------

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:
  */

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 */
 
 /*
  *-------------------------------------------------------------------------

generic/tclIO.c

@@ -7056,47 +7056,6 @@ Tcl_Tell(
     return curPos + outputBuffered;
 }
 
-/*
- *---------------------------------------------------------------------------
- *
- * 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);
-}
-
 /*
  *---------------------------------------------------------------------------
  *
@@ -9005,18 +8964,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. */

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

generic/tclIntDecls.h

@@ -1356,4 +1356,7 @@ extern const TclIntStubs *tclIntStubsPtr;
 	   (tclStubsPtr->tcl_GetCommandFullName) /* 517 */
 #endif
 
+#undef TclCopyChannelOld
+#undef TclSockMinimumBuffersOld
+
 #endif /* _TCLINTDECLS */

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)

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 */
 
 /*
  *----------------------------------------------------------------------

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 */
 
 /*
  *----------------------------------------------------------------------

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 <===
 

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)]} {

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,
@@ -493,73 +487,6 @@ TestgetopenfileCmd(
     return TCL_OK;
 }
 
-/*
- *----------------------------------------------------------------------
- *
- * 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;
-}
-
 /*
  *----------------------------------------------------------------------
  *

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) \