If TCL_NO_DEPRECATED is defined, remove the "case" statement, and use much less interp->result. Implementation mostly taken over from "novem". If TCL_NO_DEPRECATED is not defined, nothing changes.

9 files changed, 123 insertions, 74 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 37dd699..b4d0a7b 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 EXCLUDE_OBSOLETE_COMMANDS
+#ifndef TCL_NO_DEPRECATED
     {"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 4c299f8..9c6f6a1 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -149,7 +149,7 @@ Tcl_BreakObjCmd(
  *
  *----------------------------------------------------------------------
  */
-
+#ifndef TCL_NO_DEPRECATED
 	/* ARGSUSED */
 int
 Tcl_CaseObjCmd(
@@ -267,6 +267,7 @@ Tcl_CaseObjCmd(
 
     return TCL_OK;
 }
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 504af18..0dbf345 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3869,6 +3869,22 @@ extern const TclStubs *tclStubsPtr;
 #undef Tcl_AddObjErrorInfo
 #define Tcl_AddObjErrorInfo(interp, message, length) \
 	Tcl_AppendObjToErrorInfo(interp, Tcl_NewStringObj(message, length))
+#ifdef TCL_NO_DEPRECATED
+#undef Tcl_SetResult
+#define Tcl_SetResult(interp, result, freeProc) \
+	do { \
+	    char *__result = result; \
+	    Tcl_FreeProc *__freeProc = freeProc; \
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(__result, -1)); \
+	    if (__result != NULL && __freeProc != NULL && __freeProc != TCL_VOLATILE) { \
+		if (__freeProc == TCL_DYNAMIC) { \
+		    ckfree(__result); \
+		} else { \
+		    (*__freeProc)(__result); \
+		} \
+	    } \
+	} while(0)
+#endif /* TCL_NO_DEPRECATED */
 
 #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
 #   if defined(__CYGWIN__) && defined(TCL_WIDE_INT_IS_LONG)
diff --git a/generic/tclIO.c b/generic/tclIO.c
index 5c39e19..506e6d5 100644
--- a/generic/tclIO.c
+++ b/generic/tclIO.c
@@ -7127,47 +7127,6 @@ Tcl_Tell(
 /*
  *---------------------------------------------------------------------------
  *
- * Tcl_SeekOld, Tcl_TellOld --
- *
- *	Backward-compatibility 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.
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 8516385..5074378 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3219,9 +3219,11 @@ MODULE_SCOPE Tcl_Command TclInitBinaryCmd(Tcl_Interp *interp);
 MODULE_SCOPE int	Tcl_BreakObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+#ifndef TCL_NO_DEPRECATED
 MODULE_SCOPE int	Tcl_CaseObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
+#endif
 MODULE_SCOPE int	Tcl_CatchObjCmd(ClientData clientData,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 9d0714c..6346636 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -27,7 +27,9 @@ enum returnKeys {
 static Tcl_Obj **	GetKeys(void);
 static void		ReleaseKeys(ClientData clientData);
 static void		ResetObjResult(Interp *iPtr);
+#ifndef TCL_NO_DEPRECATED
 static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  * This structure is used to take a snapshot of the interpreter state in
@@ -35,7 +37,7 @@ static void		SetupAppendBuffer(Interp *iPtr, int newSpace);
  * then back up to the result or the error that was previously in progress.
  */
 
-typedef struct InterpState {
+typedef struct {
     int status;			/* return code status */
     int flags;			/* Each remaining field saves the */
     int returnLevel;		/* corresponding field of the Interp */
@@ -407,6 +409,7 @@ Tcl_DiscardResult(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_NO_DEPRECATED
 void
 Tcl_SetResult(
     Tcl_Interp *interp,		/* Interpreter with which to associate the
@@ -461,6 +464,7 @@ Tcl_SetResult(
 
     ResetObjResult(iPtr);
 }
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
@@ -483,18 +487,21 @@ const char *
 Tcl_GetStringResult(
     register Tcl_Interp *interp)/* Interpreter whose result to return. */
 {
+    Interp *iPtr = (Interp *) interp;
+#ifdef TCL_NO_DEPRECATED
+    return Tcl_GetString(iPtr->objResultPtr);
+#else
     /*
      * If the string result is empty, move the object result to the string
      * result, then reset the object result.
      */
 
-    Interp *iPtr = (Interp *) interp;
-
     if (*(iPtr->result) == 0) {
 	Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
 		TCL_VOLATILE);
     }
     return iPtr->result;
+#endif
 }
 
 /*
@@ -536,6 +543,7 @@ Tcl_SetObjResult(
 
     TclDecrRefCount(oldObjResult);
 
+#ifndef TCL_NO_DEPRECATED
     /*
      * Reset the string result since we just set the result object.
      */
@@ -550,6 +558,7 @@ Tcl_SetObjResult(
     }
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
+#endif
 }
 
 /*
@@ -578,6 +587,7 @@ Tcl_GetObjResult(
     Tcl_Interp *interp)		/* Interpreter whose result to return. */
 {
     register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
     Tcl_Obj *objResultPtr;
     int length;
 
@@ -604,6 +614,7 @@ Tcl_GetObjResult(
 	iPtr->result = iPtr->resultSpace;
 	iPtr->result[0] = 0;
     }
+#endif /* !TCL_NO_DEPRECATED */
     return iPtr->objResultPtr;
 }
 
@@ -722,6 +733,21 @@ Tcl_AppendElement(
 				 * to result. */
 {
     Interp *iPtr = (Interp *) interp;
+#ifdef TCL_NO_DEPRECATED
+    Tcl_Obj *elementPtr = Tcl_NewStringObj(element, -1);
+    Tcl_Obj *listPtr = Tcl_NewListObj(1, &elementPtr);
+    const char *bytes;
+
+    if (Tcl_IsShared(iPtr->objResultPtr)) {
+	Tcl_SetObjResult(interp, Tcl_DuplicateObj(iPtr->objResultPtr));
+    }
+    bytes = TclGetString(iPtr->objResultPtr);
+    if (TclNeedSpace(bytes, bytes+iPtr->objResultPtr->length)) {
+	Tcl_AppendToObj(iPtr->objResultPtr, " ", 1);
+    }
+    Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
+    Tcl_DecrRefCount(listPtr);
+#else
     char *dst;
     int size;
     int flags;
@@ -765,6 +791,7 @@ Tcl_AppendElement(
 	flags |= TCL_DONT_QUOTE_HASH;
     }
     iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
+#endif /* !TCL_NO_DEPRECATED */
 }
 
 /*
@@ -786,6 +813,7 @@ Tcl_AppendElement(
  *----------------------------------------------------------------------
  */
 
+#ifndef TCL_NO_DEPRECATED
 static void
 SetupAppendBuffer(
     Interp *iPtr,		/* Interpreter whose result is being set up. */
@@ -846,6 +874,7 @@ SetupAppendBuffer(
     Tcl_FreeResult((Tcl_Interp *) iPtr);
     iPtr->result = iPtr->appendResult;
 }
+#endif /* !TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
@@ -875,6 +904,7 @@ Tcl_FreeResult(
 {
     register Interp *iPtr = (Interp *) interp;
 
+#ifndef TCL_NO_DEPRECATED
     if (iPtr->freeProc != NULL) {
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
@@ -884,6 +914,7 @@ Tcl_FreeResult(
 	iPtr->freeProc = 0;
     }
 
+#endif /* !TCL_NO_DEPRECATED */
     ResetObjResult(iPtr);
 }
 
@@ -913,6 +944,7 @@ Tcl_ResetResult(
     register Interp *iPtr = (Interp *) interp;
 
     ResetObjResult(iPtr);
+#ifndef TCL_NO_DEPRECATED
     if (iPtr->freeProc != NULL) {
 	if (iPtr->freeProc == TCL_DYNAMIC) {
 	    ckfree(iPtr->result);
@@ -923,6 +955,7 @@ Tcl_ResetResult(
     }
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
     if (iPtr->errorCode) {
 	/* Legacy support */
 	if (iPtr->flags & ERR_LEGACY_COPY) {
@@ -1276,10 +1309,8 @@ TclProcessReturn(
 	Tcl_DictObjGet(NULL, iPtr->returnOpts, keys[KEY_ERRORINFO],
                 &valuePtr);
 	if (valuePtr != NULL) {
-	    int infoLen;
-
-	    (void) TclGetStringFromObj(valuePtr, &infoLen);
-	    if (infoLen) {
+	    (void) TclGetString(valuePtr);
+	    if (valuePtr->length) {
 		iPtr->errorInfo = valuePtr;
 		Tcl_IncrRefCount(iPtr->errorInfo);
 		iPtr->flags |= ERR_ALREADY_LOGGED;
@@ -1382,13 +1413,11 @@ TclMergeReturnOptions(
     Tcl_Obj **keys = GetKeys();
 
     for (;  objc > 1;  objv += 2, objc -= 2) {
-	int optLen;
-	const char *opt = TclGetStringFromObj(objv[0], &optLen);
-	int compareLen;
-	const char *compare =
-		TclGetStringFromObj(keys[KEY_OPTIONS], &compareLen);
+	const char *opt = TclGetString(objv[0]);
+	const char *compare = TclGetString(keys[KEY_OPTIONS]);
 
-	if ((optLen == compareLen) && (memcmp(opt, compare, optLen) == 0)) {
+	if ((objv[0]->length == keys[KEY_OPTIONS]->length)
+		&& (memcmp(opt, compare, objv[0]->length) == 0)) {
 	    Tcl_DictSearch search;
 	    int done = 0;
 	    Tcl_Obj *keyPtr;
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 23da6dc..561b9dd 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -290,10 +290,47 @@ static int formatInt(char *buffer, int n){
 #endif
 
 #else /* UNIX and MAC */
-#   define TclpLocaltime_unix TclpLocaltime
-#   define TclpGmtime_unix TclpGmtime
+#   ifdef TCL_NO_DEPRECATED
+#	define TclpLocaltime_unix 0
+#	define TclpGmtime_unix 0
+#   else
+#	define TclpLocaltime_unix TclpLocaltime
+#	define TclpGmtime_unix TclpGmtime
+#   endif
 #endif
 
+#ifdef TCL_NO_DEPRECATED
+#   define Tcl_SeekOld 0
+#   define Tcl_TellOld 0
+#   undef Tcl_SetResult
+#   define Tcl_SetResult 0
+#else /* TCL_NO_DEPRECATED */
+#   define Tcl_SeekOld seekOld
+#   define Tcl_TellOld tellOld
+
+static int
+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);
+}
+
+static int
+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 */
+
 /*
  * WARNING: The contents of this file is automatically generated by the
  * tools/genStubs.tcl script. Any modifications to the function declarations
diff --git a/generic/tclTest.c b/generic/tclTest.c
index faecbc6..a9dc1ca 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -290,12 +290,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,
@@ -329,12 +331,10 @@ static int		TestreturnObjCmd(ClientData dummy,
 			    Tcl_Obj *const objv[]);
 static void		TestregexpXflags(const char *string,
 			    int length, int *cflagsPtr, int *eflagsPtr);
-#ifndef TCL_NO_DEPRECATED
 static int		TestsaveresultCmd(ClientData dummy,
 			    Tcl_Interp *interp, int objc,
 			    Tcl_Obj *const objv[]);
 static void		TestsaveresultFree(char *blockPtr);
-#endif /* TCL_NO_DEPRECATED */
 static int		TestsetassocdataCmd(ClientData dummy,
 			    Tcl_Interp *interp, int argc, const char **argv);
 static int		TestsetCmd(ClientData dummy,
@@ -555,7 +555,7 @@ Tcltest_Init(
     }
     /* TIP #268: Full patchlevel instead of just major.minor */
 
-    if (Tcl_PkgProvide(interp, "Tcltest", TCL_PATCH_LEVEL) == TCL_ERROR) {
+    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
 	return TCL_ERROR;
     }
 
@@ -658,10 +658,8 @@ Tcltest_Init(
 	    NULL, NULL);
     Tcl_CreateObjCommand(interp, "testreturn", TestreturnObjCmd,
 	    NULL, NULL);
-#ifndef TCL_NO_DEPRECATED
     Tcl_CreateObjCommand(interp, "testsaveresult", TestsaveresultCmd,
 	    NULL, NULL);
-#endif /* TCL_NO_DEPRECATED */
     Tcl_CreateCommand(interp, "testsetassocdata", TestsetassocdataCmd,
 	    NULL, NULL);
     Tcl_CreateCommand(interp, "testsetnoerr", TestsetCmd,
@@ -3341,6 +3339,7 @@ TestlocaleCmd(
  */
 
 	/* ARGSUSED */
+#ifndef TCL_NO_DEPRECATED
 static int
 TestMathFunc(
     ClientData clientData,	/* Integer value to return. */
@@ -3460,6 +3459,7 @@ TestMathFunc2(
     }
     return result;
 }
+#endif /* TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
@@ -5144,7 +5144,6 @@ Testset2Cmd(
     }
 }
 
-#ifndef TCL_NO_DEPRECATED
 /*
  *----------------------------------------------------------------------
  *
@@ -5197,6 +5196,7 @@ TestsaveresultCmd(
 	return TCL_ERROR;
     }
 
+    freeCount = 0;
     objPtr = NULL;		/* Lint. */
     switch ((enum options) index) {
     case RESULT_SMALL:
@@ -5221,7 +5221,6 @@ TestsaveresultCmd(
 	break;
     }
 
-    freeCount = 0;
     Tcl_SaveResult(interp, &state);
 
     if (((enum options) index) == RESULT_OBJECT) {
@@ -5239,11 +5238,9 @@ TestsaveresultCmd(
 
     switch ((enum options) index) {
     case RESULT_DYNAMIC: {
-	int present = iPtr->freeProc == TestsaveresultFree;
-	int called = freeCount;
+	int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;
 
-	Tcl_AppendElement(interp, called ? "called" : "notCalled");
-	Tcl_AppendElement(interp, present ? "present" : "missing");
+	Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
 	break;
     }
     case RESULT_OBJECT:
@@ -5278,7 +5275,6 @@ TestsaveresultFree(
 {
     freeCount++;
 }
-#endif /* TCL_NO_DEPRECATED */
 
 /*
  *----------------------------------------------------------------------
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index 531f386..ba709cc 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2894,7 +2894,6 @@ Tcl_DStringResult(
     Tcl_DString *dsPtr)		/* Dynamic string that is to become the
 				 * result of interp. */
 {
-    Tcl_ResetResult(interp);
     Tcl_SetObjResult(interp, TclDStringToObj(dsPtr));
 }
 
@@ -2924,6 +2923,14 @@ Tcl_DStringGetResult(
     Tcl_DString *dsPtr)		/* Dynamic string that is to become the result
 				 * of interp. */
 {
+#ifdef TCL_NO_DEPRECATED
+    Tcl_Obj *obj = Tcl_GetObjResult(interp);
+    const char *bytes = TclGetString(obj);
+
+    Tcl_DStringFree(dsPtr);
+    Tcl_DStringAppend(dsPtr, bytes, obj->length);
+    Tcl_ResetResult(interp);
+#else
     Interp *iPtr = (Interp *) interp;
 
     if (dsPtr->string != dsPtr->staticSpace) {
@@ -2932,7 +2939,7 @@ Tcl_DStringGetResult(
 
     /*
      * Do more efficient transfer when we know the result is a Tcl_Obj. When
-     * there's no st`ring result, we only have to deal with two cases:
+     * there's no string result, we only have to deal with two cases:
      *
      *  1. When the string rep is the empty string, when we don't copy but
      *     instead use the staticSpace in the DString to hold an empty string.
@@ -2995,6 +3002,7 @@ Tcl_DStringGetResult(
 
     iPtr->result = iPtr->resultSpace;
     iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
 }
 
 /*
@@ -3576,7 +3584,7 @@ TclGetIntForIndex(
     int *indexPtr)		/* Location filled in with an integer
 				 * representing an index. */
 {
-    int length;
+    size_t length;
     char *opPtr;
     const char *bytes;
 
@@ -3594,7 +3602,8 @@ TclGetIntForIndex(
 	return TCL_OK;
     }
 
-    bytes = TclGetStringFromObj(objPtr, &length);
+    bytes = TclGetString(objPtr);
+    length = objPtr->length;
 
     /*
      * Leading whitespace is acceptable in an index.