summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorhypnotoad <yoda@etoyoc.com>2013-04-29 12:31:11 (GMT)
committerhypnotoad <yoda@etoyoc.com>2013-04-29 12:31:11 (GMT)
commit7e98e681444fc1b49413624707b811aa45a5b6fa (patch)
tree9624a61058e7f648dd4d3e730572daf142b344c9 /generic
parentf23f5f814767bd8ee631943d6a6840ed563e0dea (diff)
parent1d75b0eb9444d42e7399a40853deb8bb47a88e4d (diff)
downloadtcl-hypnotoad_prefer_native_8_6.zip
tcl-hypnotoad_prefer_native_8_6.tar.gz
tcl-hypnotoad_prefer_native_8_6.tar.bz2
Bringing patch up to date with the latest trunkhypnotoad_prefer_native_8_6
Diffstat (limited to 'generic')
-rw-r--r--generic/regc_color.c7
-rw-r--r--generic/regerrs.h1
-rw-r--r--generic/regex.h1
-rw-r--r--generic/regguts.h1
-rw-r--r--generic/tclBasic.c6
-rw-r--r--generic/tclCmdMZ.c4
-rw-r--r--generic/tclCompCmds.c82
-rw-r--r--generic/tclDecls.h62
-rw-r--r--generic/tclExecute.c58
-rw-r--r--generic/tclFCmd.c17
-rw-r--r--generic/tclInt.h29
-rw-r--r--generic/tclIntDecls.h3
-rw-r--r--generic/tclObj.c34
-rw-r--r--generic/tclPkg.c4
-rw-r--r--generic/tclProc.c2
-rwxr-xr-xgeneric/tclStrToD.c4
-rw-r--r--generic/tclTest.c24
-rw-r--r--generic/tclTimer.c2
-rw-r--r--generic/tclZlib.c18
19 files changed, 233 insertions, 126 deletions
diff --git a/generic/regc_color.c b/generic/regc_color.c
index b7a571c..f5d6dfd 100644
--- a/generic/regc_color.c
+++ b/generic/regc_color.c
@@ -254,7 +254,14 @@ newcolor(
* Oops, must allocate more.
*/
+ if (cm->max == MAX_COLOR) {
+ CERR(REG_ECOLORS);
+ return COLORLESS; /* too many colors */
+ }
n = cm->ncds * 2;
+ if (n < MAX_COLOR + 1) {
+ n = MAX_COLOR + 1;
+ }
if (cm->cd == cm->cdspace) {
newCd = (struct colordesc *) MALLOC(n * sizeof(struct colordesc));
if (newCd != NULL) {
diff --git a/generic/regerrs.h b/generic/regerrs.h
index 259c0cb..72548ff 100644
--- a/generic/regerrs.h
+++ b/generic/regerrs.h
@@ -17,3 +17,4 @@
{ REG_MIXED, "REG_MIXED", "character widths of regex and string differ" },
{ REG_BADOPT, "REG_BADOPT", "invalid embedded option" },
{ REG_ETOOBIG, "REG_ETOOBIG", "nfa has too many states" },
+{ REG_ECOLORS, "REG_ECOLORS", "too many colors" },
diff --git a/generic/regex.h b/generic/regex.h
index d6d46ce..9466fbb 100644
--- a/generic/regex.h
+++ b/generic/regex.h
@@ -281,6 +281,7 @@ typedef struct {
#define REG_MIXED 17 /* character widths of regex and string differ */
#define REG_BADOPT 18 /* invalid embedded option */
#define REG_ETOOBIG 19 /* nfa has too many states */
+#define REG_ECOLORS 20 /* too many colors */
/* two specials for debugging and testing */
#define REG_ATOI 101 /* convert error-code name to number */
#define REG_ITOA 102 /* convert error-code number to name */
diff --git a/generic/regguts.h b/generic/regguts.h
index 67f9625..b4944dc 100644
--- a/generic/regguts.h
+++ b/generic/regguts.h
@@ -145,6 +145,7 @@
typedef short color; /* colors of characters */
typedef int pcolor; /* what color promotes to */
+#define MAX_COLOR SHRT_MAX /* max color value */
#define COLORLESS (-1) /* impossible color */
#define WHITE 0 /* default color, parent of all others */
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index f57b4ea..b39d346 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -5847,6 +5847,7 @@ Tcl_Eval(
*----------------------------------------------------------------------
*/
+#undef Tcl_EvalObj
int
Tcl_EvalObj(
Tcl_Interp *interp,
@@ -5854,6 +5855,7 @@ Tcl_EvalObj(
{
return Tcl_EvalObjEx(interp, objPtr, 0);
}
+#undef Tcl_GlobalEvalObj
int
Tcl_GlobalEvalObj(
Tcl_Interp *interp,
@@ -6742,6 +6744,7 @@ Tcl_ExprString(
*----------------------------------------------------------------------
*/
+#undef Tcl_AddObjErrorInfo
void
Tcl_AppendObjToErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
@@ -6806,7 +6809,6 @@ Tcl_AddErrorInfo(
*----------------------------------------------------------------------
*/
-#undef Tcl_AddObjErrorInfo
void
Tcl_AddObjErrorInfo(
Tcl_Interp *interp, /* Interpreter to which error information
@@ -7476,7 +7478,7 @@ ExprAbsFunc(
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (type == TCL_NUMBER_WIDE) {
Tcl_WideInt w = *((const Tcl_WideInt *) ptr);
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index f9f2a28..fc4624b 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -1565,7 +1565,7 @@ StringIsCmd(
/* TODO */
if ((objPtr->typePtr == &tclDoubleType) ||
(objPtr->typePtr == &tclIntType) ||
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
(objPtr->typePtr == &tclWideIntType) ||
#endif
(objPtr->typePtr == &tclBignumType)) {
@@ -1602,7 +1602,7 @@ StringIsCmd(
goto failedIntParse;
case STR_IS_ENTIER:
if ((objPtr->typePtr == &tclIntType) ||
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
(objPtr->typePtr == &tclWideIntType) ||
#endif
(objPtr->typePtr == &tclBignumType)) {
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 40348fa..f6ca0e0 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -286,8 +286,10 @@ TclCompileArraySetCmd(
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *dataTokenPtr;
int simpleVarName, isScalar, localIndex;
+ int isDataLiteral, isDataValid, isDataEven, len;
int dataVar, iterVar, keyVar, valVar, infoIndex;
int back, fwd, offsetBack, offsetFwd, savedStackDepth;
+ Tcl_Obj *literalObj;
ForeachInfo *infoPtr;
if (parsePtr->numWords != 3) {
@@ -297,18 +299,22 @@ TclCompileArraySetCmd(
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_ELEMENT,
&localIndex, &simpleVarName, &isScalar, 1);
- dataTokenPtr = TokenAfter(varTokenPtr);
if (!isScalar) {
return TCL_ERROR;
}
+ dataTokenPtr = TokenAfter(varTokenPtr);
+ literalObj = Tcl_NewObj();
+ isDataLiteral = TclWordKnownAtCompileTime(dataTokenPtr, literalObj);
+ isDataValid = (isDataLiteral
+ && Tcl_ListObjLength(NULL, literalObj, &len) == TCL_OK);
+ isDataEven = (isDataValid && (len & 1) == 0);
/*
* Special case: literal empty value argument is just an "ensure array"
* operation.
*/
- if (dataTokenPtr->type == TCL_TOKEN_SIMPLE_WORD
- && dataTokenPtr[1].size == 0) {
+ if (isDataEven && len == 0) {
if (localIndex >= 0) {
TclEmitInstInt4(INST_ARRAY_EXISTS_IMM, localIndex, envPtr);
TclEmitInstInt1(INST_JUMP_TRUE1, 7, envPtr);
@@ -324,7 +330,24 @@ TclCompileArraySetCmd(
TclEmitOpcode( INST_POP, envPtr);
}
PushLiteral(envPtr, "", 0);
- return TCL_OK;
+ goto done;
+ }
+
+ /*
+ * Special case: literal odd-length argument is always an error.
+ */
+
+ if (isDataValid && !isDataEven) {
+ savedStackDepth = envPtr->currStackDepth;
+ PushLiteral(envPtr, "list must have an even number of elements",
+ strlen("list must have an even number of elements"));
+ PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
+ strlen("-errorCode {TCL ARGUMENT FORMAT}"));
+ TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ TclEmitInt4( 0, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ PushLiteral(envPtr, "", 0);
+ goto done;
}
/*
@@ -359,7 +382,7 @@ TclCompileArraySetCmd(
}
CompileWord(envPtr, dataTokenPtr, interp, 2);
TclEmitInstInt1(INST_INVOKE_STK1, 3, envPtr);
- return TCL_OK;
+ goto done;
}
infoPtr = ckalloc(sizeof(ForeachInfo) + sizeof(ForeachVarList *));
@@ -377,22 +400,31 @@ TclCompileArraySetCmd(
*/
CompileWord(envPtr, dataTokenPtr, interp, 2);
- TclEmitOpcode( INST_DUP, envPtr);
- TclEmitOpcode( INST_LIST_LENGTH, envPtr);
- PushLiteral(envPtr, "1", 1);
- TclEmitOpcode( INST_BITAND, envPtr);
- offsetFwd = CurrentOffset(envPtr);
- TclEmitInstInt1( INST_JUMP_FALSE1, 0, envPtr);
- savedStackDepth = envPtr->currStackDepth;
- PushLiteral(envPtr, "list must have an even number of elements",
- strlen("list must have an even number of elements"));
- PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
- strlen("-errorCode {TCL ARGUMENT FORMAT}"));
- TclEmitInstInt4( INST_RETURN_IMM, 1, envPtr);
- TclEmitInt4( 0, envPtr);
- envPtr->currStackDepth = savedStackDepth;
- fwd = CurrentOffset(envPtr) - offsetFwd;
- TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ if (!isDataLiteral || !isDataValid) {
+ /*
+ * Only need this safety check if we're handling a non-literal or list
+ * containing an invalid literal; with valid list literals, we've
+ * already checked (worth it because literals are a very common
+ * use-case with [array set]).
+ */
+
+ TclEmitOpcode( INST_DUP, envPtr);
+ TclEmitOpcode( INST_LIST_LENGTH, envPtr);
+ PushLiteral(envPtr, "1", 1);
+ TclEmitOpcode( INST_BITAND, envPtr);
+ offsetFwd = CurrentOffset(envPtr);
+ TclEmitInstInt1(INST_JUMP_FALSE1, 0, envPtr);
+ savedStackDepth = envPtr->currStackDepth;
+ PushLiteral(envPtr, "list must have an even number of elements",
+ strlen("list must have an even number of elements"));
+ PushLiteral(envPtr, "-errorCode {TCL ARGUMENT FORMAT}",
+ strlen("-errorCode {TCL ARGUMENT FORMAT}"));
+ TclEmitInstInt4(INST_RETURN_IMM, 1, envPtr);
+ TclEmitInt4( 0, envPtr);
+ envPtr->currStackDepth = savedStackDepth;
+ fwd = CurrentOffset(envPtr) - offsetFwd;
+ TclStoreInt1AtPtr(fwd, envPtr->codeStart+offsetFwd+1);
+ }
Emit14Inst( INST_STORE_SCALAR, dataVar, envPtr);
TclEmitOpcode( INST_POP, envPtr);
@@ -439,9 +471,13 @@ TclCompileArraySetCmd(
envPtr->currStackDepth = savedStackDepth;
TclEmitOpcode( INST_POP, envPtr);
}
- TclEmitInstInt1( INST_UNSET_SCALAR, 0, envPtr);
- TclEmitInt4( dataVar, envPtr);
+ if (!isDataLiteral) {
+ TclEmitInstInt1(INST_UNSET_SCALAR, 0, envPtr);
+ TclEmitInt4( dataVar, envPtr);
+ }
PushLiteral(envPtr, "", 0);
+ done:
+ Tcl_DecrRefCount(literalObj);
return TCL_OK;
}
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index d931873..3156f6d 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3806,16 +3806,62 @@ extern const TclStubs *tclStubsPtr;
#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
+#undef Tcl_SeekOld
+#undef Tcl_TellOld
+
+#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_GetIndexFromObj
+#define Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) \
+ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, \
+ sizeof(char *), msg, flags, indexPtr)
+#undef Tcl_NewBooleanObj
+#define Tcl_NewBooleanObj(boolValue) \
+ Tcl_NewIntObj((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_SetIntObj((objPtr), (boolValue)!=0)
+#undef Tcl_SetVar
+#define Tcl_SetVar(interp, varName, newValue, flags) \
+ Tcl_SetVar2(interp, varName, NULL, newValue, flags)
+#undef Tcl_UnsetVar
+#define Tcl_UnsetVar(interp, varName, flags) \
+ Tcl_UnsetVar2(interp, varName, NULL, flags)
+#undef Tcl_GetVar
+#define Tcl_GetVar(interp, varName, flags) \
+ Tcl_GetVar2(interp, varName, NULL, flags)
+#undef Tcl_TraceVar
+#define Tcl_TraceVar(interp, varName, flags, proc, clientData) \
+ Tcl_TraceVar2(interp, varName, NULL, flags, proc, clientData)
+#undef Tcl_UntraceVar
+#define Tcl_UntraceVar(interp, varName, flags, proc, clientData) \
+ Tcl_UntraceVar2(interp, varName, NULL, flags, proc, clientData)
+#undef Tcl_VarTraceInfo
+#define Tcl_VarTraceInfo(interp, varName, flags, proc, prevClientData) \
+ Tcl_VarTraceInfo2(interp, varName, NULL, flags, proc, prevClientData)
+#undef Tcl_UpVar
+#define Tcl_UpVar(interp, frameName, varName, localName, flags) \
+ Tcl_UpVar2(interp, frameName, varName, NULL, localName, flags)
+
/*
* Deprecated Tcl procedures:
*/
-#if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS)
-# undef Tcl_EvalObj
-# define Tcl_EvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),0)
-# undef Tcl_GlobalEvalObj
-# define Tcl_GlobalEvalObj(interp,objPtr) \
- Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
-#endif
+
+#undef Tcl_EvalObj
+#define Tcl_EvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),0)
+#undef Tcl_GlobalEvalObj
+#define Tcl_GlobalEvalObj(interp,objPtr) \
+ Tcl_EvalObjEx((interp),(objPtr),TCL_EVAL_GLOBAL)
#endif /* _TCLDECLS */
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index be2e3ca..029f402 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -434,7 +434,7 @@ VarHashCreateVar(
* ClientData *ptrPtr, int *tPtr);
*/
-#ifdef NO_WIDE_TYPE
+#ifdef TCL_WIDE_INT_IS_LONG
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(tPtr) = TCL_NUMBER_LONG, \
@@ -450,7 +450,7 @@ VarHashCreateVar(
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-#else /* !NO_WIDE_TYPE */
+#else /* !TCL_WIDE_INT_IS_LONG */
#define GetNumberFromObj(interp, objPtr, ptrPtr, tPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(tPtr) = TCL_NUMBER_LONG, \
@@ -470,7 +470,7 @@ VarHashCreateVar(
(((objPtr)->bytes != NULL) && ((objPtr)->length == 0))) \
? TCL_ERROR : \
TclGetNumberFromObj((interp), (objPtr), (ptrPtr), (tPtr)))
-#endif /* NO_WIDE_TYPE */
+#endif /* TCL_WIDE_INT_IS_LONG */
/*
* Macro used in this file to save a function call for common uses of
@@ -494,13 +494,13 @@ VarHashCreateVar(
* Tcl_WideInt *wideIntPtr);
*/
-#ifdef NO_WIDE_TYPE
+#ifdef TCL_WIDE_INT_IS_LONG
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclIntType) \
? (*(wideIntPtr) = (Tcl_WideInt) \
((objPtr)->internalRep.longValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#else /* !NO_WIDE_TYPE */
+#else /* !TCL_WIDE_INT_IS_LONG */
#define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \
(((objPtr)->typePtr == &tclWideIntType) \
? (*(wideIntPtr) = (objPtr)->internalRep.wideValue, TCL_OK) : \
@@ -508,7 +508,7 @@ VarHashCreateVar(
? (*(wideIntPtr) = (Tcl_WideInt) \
((objPtr)->internalRep.longValue), TCL_OK) : \
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
-#endif /* NO_WIDE_TYPE */
+#endif /* TCL_WIDE_INT_IS_LONG */
/*
* Macro used to make the check for type overflow more mnemonic. This works by
@@ -1868,7 +1868,7 @@ TclIncrObj(
TclSetLongObj(valuePtr, sum);
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
{
Tcl_WideInt w1 = (Tcl_WideInt) augend;
Tcl_WideInt w2 = (Tcl_WideInt) addend;
@@ -1901,7 +1901,7 @@ TclIncrObj(
return TCL_ERROR;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if ((type1 != TCL_NUMBER_BIG) && (type2 != TCL_NUMBER_BIG)) {
Tcl_WideInt w1, w2, sum;
@@ -3414,7 +3414,7 @@ TEBCresume(
{
Tcl_Obj *incrPtr;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w;
#endif
long increment;
@@ -3536,7 +3536,7 @@ TEBCresume(
}
goto doneIncr;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
w = (Tcl_WideInt)augend;
TRACE(("%u %ld => ", opnd, increment));
@@ -3558,7 +3558,7 @@ TEBCresume(
goto doneIncr;
#endif
} /* end if (type == TCL_NUMBER_LONG) */
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (type == TCL_NUMBER_WIDE) {
Tcl_WideInt sum;
@@ -5634,7 +5634,7 @@ TEBCresume(
w1 = (Tcl_WideInt) l1;
w2 = (Tcl_WideInt) l2;
wResult = w1 + w2;
-#ifdef NO_WIDE_TYPE
+#ifdef TCL_WIDE_INT_IS_LONG
/*
* Check for overflow.
*/
@@ -5649,7 +5649,7 @@ TEBCresume(
w1 = (Tcl_WideInt) l1;
w2 = (Tcl_WideInt) l2;
wResult = w1 - w2;
-#ifdef NO_WIDE_TYPE
+#ifdef TCL_WIDE_INT_IS_LONG
/*
* Must check for overflow. The macro tests for overflows in
* sums by looking at the sign bits. As we have a subtraction
@@ -7194,7 +7194,7 @@ ExecuteExtendedBinaryMathOp(
return constants[0];
}
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *)ptr1);
if (type2 != TCL_NUMBER_BIG) {
@@ -7269,7 +7269,7 @@ ExecuteExtendedBinaryMathOp(
case TCL_NUMBER_LONG:
invalid = (*((const long *)ptr2) < 0L);
break;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
invalid = (*((const Tcl_WideInt *)ptr2) < (Tcl_WideInt)0);
break;
@@ -7353,7 +7353,7 @@ ExecuteExtendedBinaryMathOp(
case TCL_NUMBER_LONG:
zero = (*(const long *)ptr1 > 0L);
break;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
zero = (*(const Tcl_WideInt *)ptr1 > (Tcl_WideInt)0);
break;
@@ -7374,7 +7374,7 @@ ExecuteExtendedBinaryMathOp(
}
shift = (int)(*(const long *)ptr2);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
/*
* Handle shifts within the native wide range.
*/
@@ -7557,7 +7557,7 @@ ExecuteExtendedBinaryMathOp(
BIG_RESULT(&bigResult);
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE)) {
TclGetWideIntFromObj(NULL, valuePtr, &w1);
TclGetWideIntFromObj(NULL, value2Ptr, &w2);
@@ -7635,7 +7635,7 @@ ExecuteExtendedBinaryMathOp(
negativeExponent = (l2 < 0);
oddExponent = (int) (l2 & 1);
break;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
negativeExponent = (w2 < 0);
@@ -7827,7 +7827,7 @@ ExecuteExtendedBinaryMathOp(
#if (LONG_MAX > 0x7fffffff) || !defined(TCL_WIDE_INT_IS_LONG)
if (type1 == TCL_NUMBER_LONG) {
w1 = l1;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
} else if (type1 == TCL_NUMBER_WIDE) {
w1 = *((const Tcl_WideInt *) ptr1);
#endif
@@ -8030,7 +8030,7 @@ ExecuteExtendedBinaryMathOp(
switch (opcode) {
case INST_ADD:
wResult = w1 + w2;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
{
@@ -8046,7 +8046,7 @@ ExecuteExtendedBinaryMathOp(
case INST_SUB:
wResult = w1 - w2;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if ((type1 == TCL_NUMBER_WIDE) || (type2 == TCL_NUMBER_WIDE))
#endif
{
@@ -8172,7 +8172,7 @@ ExecuteExtendedUnaryMathOp(
switch (opcode) {
case INST_BITNOT:
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (type == TCL_NUMBER_WIDE) {
w = *((const Tcl_WideInt *) ptr);
WIDE_RESULT(~w);
@@ -8194,7 +8194,7 @@ ExecuteExtendedUnaryMathOp(
}
TclBNInitBignumFromLong(&big, *(const long *) ptr);
break;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
w = *((const Tcl_WideInt *) ptr);
if (w != LLONG_MIN) {
@@ -8246,7 +8246,7 @@ TclCompareTwoNumbers(
mp_int big1, big2;
double d1, d2, tmp;
long l1, l2;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w1, w2;
#endif
@@ -8261,7 +8261,7 @@ TclCompareTwoNumbers(
l2 = *((const long *)ptr2);
longCompare:
return (l1 < l2) ? MP_LT : ((l1 > l2) ? MP_GT : MP_EQ);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
w1 = (Tcl_WideInt)l1;
@@ -8313,7 +8313,7 @@ TclCompareTwoNumbers(
return compare;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
w1 = *((const Tcl_WideInt *)ptr1);
switch (type2) {
@@ -8374,7 +8374,7 @@ TclCompareTwoNumbers(
}
l1 = (long) d1;
goto longCompare;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
w2 = *((const Tcl_WideInt *)ptr2);
d2 = (double) w2;
@@ -8418,7 +8418,7 @@ TclCompareTwoNumbers(
case TCL_NUMBER_BIG:
Tcl_TakeBignumFromObj(NULL, valuePtr, &big1);
switch (type2) {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
case TCL_NUMBER_WIDE:
#endif
case TCL_NUMBER_LONG:
diff --git a/generic/tclFCmd.c b/generic/tclFCmd.c
index 33c1496..13377d3 100644
--- a/generic/tclFCmd.c
+++ b/generic/tclFCmd.c
@@ -734,17 +734,14 @@ CopyRenameOneFile(
*/
errfile = target;
-
- /*
- * We now need to reset the result, because the above call, if it
- * failed, may have put an error message in place. (Ideally we
- * would prefer not to pass an interpreter in above, but the
- * channel IO code used by TclCrossFilesystemCopy currently
- * requires one).
- */
-
- Tcl_ResetResult(interp);
}
+ /*
+ * We now need to reset the result, because the above call,
+ * may have left set it. (Ideally we would prefer not to pass
+ * an interpreter in above, but the channel IO code used by
+ * TclCrossFilesystemCopy currently requires one)
+ */
+ Tcl_ResetResult(interp);
}
if ((copyFlag == 0) && (result == TCL_OK)) {
if (S_ISDIR(sourceStatBuf.st_mode)) {
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 1f939c0..5b113bf 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -23,7 +23,6 @@
* Some numerics configuration options.
*/
-#undef NO_WIDE_TYPE
#undef ACCEPT_NAN
/*
@@ -96,14 +95,6 @@ typedef int ptrdiff_t;
#endif
/*
- * When Tcl_WideInt and long are the same type, there's no value in
- * having a tclWideIntType separate from the tclIntType.
- */
-#ifdef TCL_WIDE_INT_IS_LONG
-#define NO_WIDE_TYPE
-#endif
-
-/*
* Macros used to cast between pointers and integers (e.g. when storing an int
* in ClientData), on 64-bit architectures they avoid gcc warning about "cast
* to/from pointer from/to integer of different size".
@@ -2671,7 +2662,7 @@ MODULE_SCOPE const Tcl_ObjType tclProcBodyType;
MODULE_SCOPE const Tcl_ObjType tclStringType;
MODULE_SCOPE const Tcl_ObjType tclArraySearchType;
MODULE_SCOPE const Tcl_ObjType tclEnsembleCmdType;
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
MODULE_SCOPE const Tcl_ObjType tclWideIntType;
#endif
MODULE_SCOPE const Tcl_ObjType tclRegexpType;
@@ -4408,7 +4399,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*----------------------------------------------------------------
*/
-#define TclSetIntObj(objPtr, i) \
+#define TclSetLongObj(objPtr, i) \
do { \
TclInvalidateStringRep(objPtr); \
TclFreeIntRep(objPtr); \
@@ -4416,8 +4407,8 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
(objPtr)->typePtr = &tclIntType; \
} while (0)
-#define TclSetLongObj(objPtr, l) \
- TclSetIntObj((objPtr), (l))
+#define TclSetIntObj(objPtr, l) \
+ TclSetLongObj(objPtr, l)
/*
* NOTE: There is to be no such thing as a "pure" boolean. Boolean values set
@@ -4427,9 +4418,9 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#define TclSetBooleanObj(objPtr, b) \
- TclSetIntObj((objPtr), ((b)? 1 : 0));
+ TclSetLongObj(objPtr, (b)!=0);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
#define TclSetWideIntObj(objPtr, w) \
do { \
TclInvalidateStringRep(objPtr); \
@@ -4465,7 +4456,7 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
*/
#ifndef TCL_MEM_DEBUG
-#define TclNewIntObj(objPtr, i) \
+#define TclNewLongObj(objPtr, i) \
do { \
TclIncrObjsAllocated(); \
TclAllocObjStorage(objPtr); \
@@ -4476,15 +4467,15 @@ MODULE_SCOPE Tcl_PackageInitProc Procbodytest_SafeInit;
TCL_DTRACE_OBJ_CREATE(objPtr); \
} while (0)
-#define TclNewLongObj(objPtr, l) \
- TclNewIntObj((objPtr), (l))
+#define TclNewIntObj(objPtr, l) \
+ TclNewLongObj(objPtr, l)
/*
* NOTE: There is to be no such thing as a "pure" boolean.
* See comment above TclSetBooleanObj macro above.
*/
#define TclNewBooleanObj(objPtr, b) \
- TclNewIntObj((objPtr), ((b)? 1 : 0))
+ TclNewLongObj((objPtr), (b)!=0)
#define TclNewDoubleObj(objPtr, d) \
do { \
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/tclObj.c b/generic/tclObj.c
index 1bed667..542d6d1 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -212,7 +212,7 @@ static int SetDoubleFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static int SetIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
static void UpdateStringOfDouble(Tcl_Obj *objPtr);
static void UpdateStringOfInt(Tcl_Obj *objPtr);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
static void UpdateStringOfWideInt(Tcl_Obj *objPtr);
static int SetWideIntFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr);
#endif
@@ -272,7 +272,7 @@ const Tcl_ObjType tclIntType = {
UpdateStringOfInt, /* updateStringProc */
SetIntFromAny /* setFromAnyProc */
};
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
const Tcl_ObjType tclWideIntType = {
"wideInt", /* name */
NULL, /* freeIntRepProc */
@@ -410,7 +410,7 @@ TclInitObjSubsystem(void)
/* For backward compatibility only ... */
Tcl_RegisterObjType(&oldBooleanType);
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
Tcl_RegisterObjType(&tclWideIntType);
#endif
@@ -1915,7 +1915,7 @@ Tcl_GetBooleanFromObj(
*boolPtr = 1;
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*boolPtr = (objPtr->internalRep.wideValue != 0);
return TCL_OK;
@@ -1970,7 +1970,7 @@ TclSetBooleanFromAny(
goto badBoolean;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
goto badBoolean;
}
@@ -2302,7 +2302,7 @@ Tcl_GetDoubleFromObj(
*dblPtr = TclBignumToDouble(&big);
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*dblPtr = (double) objPtr->internalRep.wideValue;
return TCL_OK;
@@ -2760,7 +2760,7 @@ Tcl_GetLongFromObj(
*longPtr = objPtr->internalRep.longValue;
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
/*
* We return any integer in the range -ULONG_MAX to ULONG_MAX
@@ -2818,7 +2818,7 @@ Tcl_GetLongFromObj(
return TCL_OK;
}
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
tooLarge:
#endif
if (interp != NULL) {
@@ -2834,7 +2834,7 @@ Tcl_GetLongFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
@@ -2876,7 +2876,7 @@ UpdateStringOfWideInt(
memcpy(objPtr->bytes, buffer, len + 1);
objPtr->length = len;
}
-#endif /* !NO_WIDE_TYPE */
+#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -3031,7 +3031,7 @@ Tcl_SetWideIntObj(
&& (wideValue <= (Tcl_WideInt) LONG_MAX)) {
TclSetLongObj(objPtr, (long) wideValue);
} else {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
TclSetWideIntObj(objPtr, wideValue);
#else
mp_int big;
@@ -3071,7 +3071,7 @@ Tcl_GetWideIntFromObj(
/* Place to store resulting long. */
{
do {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*wideIntPtr = objPtr->internalRep.wideValue;
return TCL_OK;
@@ -3131,7 +3131,7 @@ Tcl_GetWideIntFromObj(
TCL_PARSE_INTEGER_ONLY)==TCL_OK);
return TCL_ERROR;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
/*
*----------------------------------------------------------------------
@@ -3157,7 +3157,7 @@ SetWideIntFromAny(
Tcl_WideInt w;
return Tcl_GetWideIntFromObj(interp, objPtr, &w);
}
-#endif /* !NO_WIDE_TYPE */
+#endif /* !TCL_WIDE_INT_IS_LONG */
/*
*----------------------------------------------------------------------
@@ -3405,7 +3405,7 @@ GetBignumFromObj(
TclBNInitBignumFromLong(bignumValue, objPtr->internalRep.longValue);
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
TclBNInitBignumFromWideInt(bignumValue,
objPtr->internalRep.wideValue);
@@ -3544,7 +3544,7 @@ Tcl_SetBignumObj(
return;
}
tooLargeForLong:
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if ((size_t) bignumValue->used
<= (CHAR_BIT * sizeof(Tcl_WideInt) + DIGIT_BIT - 1) / DIGIT_BIT) {
Tcl_WideUInt value = 0;
@@ -3656,7 +3656,7 @@ TclGetNumberFromObj(
*clientDataPtr = &objPtr->internalRep.longValue;
return TCL_OK;
}
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (objPtr->typePtr == &tclWideIntType) {
*typePtr = TCL_NUMBER_WIDE;
*clientDataPtr = &objPtr->internalRep.wideValue;
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 07f62a4..df90cea 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -949,7 +949,7 @@ Tcl_PackageObjCmd(
version = TclGetString(objv[3]);
}
}
- Tcl_PkgPresent(interp, name, version, exact);
+ Tcl_PkgPresentEx(interp, name, version, exact, NULL);
return TCL_ERROR;
break;
}
@@ -974,7 +974,7 @@ Tcl_PackageObjCmd(
if (CheckVersionAndConvert(interp, argv3, NULL, NULL) != TCL_OK) {
return TCL_ERROR;
}
- return Tcl_PkgProvide(interp, argv2, argv3);
+ return Tcl_PkgProvideEx(interp, argv2, argv3, NULL);
case PKG_REQUIRE:
require:
if (objc < 3) {
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 13f6f8a..18985a1 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -837,7 +837,7 @@ TclObjGetFrame(
}
/* TODO: Consider skipping the typePtr checks */
} else if (objPtr->typePtr == &tclIntType
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
|| objPtr->typePtr == &tclWideIntType
#endif
) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index 2d534a68..883e2ea 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -1239,7 +1239,7 @@ TclParseNumber(
if (!octalSignificandOverflow) {
if (octalSignificandWide >
(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (octalSignificandWide <= (MOST_BITS + signum)) {
objPtr->typePtr = &tclWideIntType;
if (signum) {
@@ -1286,7 +1286,7 @@ TclParseNumber(
if (!significandOverflow) {
if (significandWide >
(Tcl_WideUInt)(((~(unsigned long)0) >> 1) + signum)) {
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
if (significandWide <= MOST_BITS+signum) {
objPtr->typePtr = &tclWideIntType;
if (signum) {
diff --git a/generic/tclTest.c b/generic/tclTest.c
index a8b27fb..835036b 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -327,10 +327,12 @@ 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,
@@ -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;
@@ -642,8 +646,10 @@ 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,
@@ -665,8 +671,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 +685,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_NO_DEPRECATED */
Tcl_CreateObjCommand(interp, "testnrelevels", TestNRELevels,
NULL, NULL);
@@ -5003,6 +5013,7 @@ Testset2Cmd(
}
}
+#ifndef TCL_NO_DEPRECATED
/*
*----------------------------------------------------------------------
*
@@ -5136,6 +5147,7 @@ TestsaveresultFree(
{
freeCount++;
}
+#endif /* TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -6170,7 +6182,7 @@ TestReport(
* API, but there you go. We should convert it to objects.
*/
- Tcl_SavedResult savedResult;
+ Tcl_Obj *savedResult;
Tcl_DString ds;
Tcl_DStringInit(&ds);
@@ -6184,11 +6196,15 @@ TestReport(
Tcl_DStringAppendElement(&ds, Tcl_GetString(arg2));
}
Tcl_DStringEndSublist(&ds);
- Tcl_SaveResult(interp, &savedResult);
+ savedResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(savedResult);
+ Tcl_SetObjResult(interp, Tcl_NewObj());
Tcl_Eval(interp, Tcl_DStringValue(&ds));
Tcl_DStringFree(&ds);
- Tcl_RestoreResult(interp, &savedResult);
- }
+ Tcl_ResetResult(interp);
+ Tcl_SetObjResult(interp, savedResult);
+ Tcl_DecrRefCount(savedResult);
+ }
}
static int
diff --git a/generic/tclTimer.c b/generic/tclTimer.c
index 6b17825..c10986a 100644
--- a/generic/tclTimer.c
+++ b/generic/tclTimer.c
@@ -819,7 +819,7 @@ Tcl_AfterObjCmd(
*/
if (objv[1]->typePtr == &tclIntType
-#ifndef NO_WIDE_TYPE
+#ifndef TCL_WIDE_INT_IS_LONG
|| objv[1]->typePtr == &tclWideIntType
#endif
|| objv[1]->typePtr == &tclBignumType
diff --git a/generic/tclZlib.c b/generic/tclZlib.c
index ff887c8..9bceb4c 100644
--- a/generic/tclZlib.c
+++ b/generic/tclZlib.c
@@ -3891,8 +3891,10 @@ Tcl_ZlibStreamInit(
Tcl_Obj *dictObj,
Tcl_ZlibStream *zshandle)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
- Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
return TCL_ERROR;
}
@@ -3957,8 +3959,10 @@ Tcl_ZlibDeflate(
int level,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
- Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
return TCL_ERROR;
}
@@ -3970,8 +3974,10 @@ Tcl_ZlibInflate(
int bufferSize,
Tcl_Obj *gzipHeaderDictObj)
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
- Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ if (interp) {
+ Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1));
+ Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", NULL);
+ }
return TCL_ERROR;
}