summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorjan.nijtmans <nijtmans@users.sourceforge.net>2017-11-09 14:59:36 (GMT)
committerjan.nijtmans <nijtmans@users.sourceforge.net>2017-11-09 14:59:36 (GMT)
commit944a3d95ffd92e872e30021a6b4bc7d932759c22 (patch)
tree115e9c7476f7164837b7122760147ae95bd5b422
parent29dda71bad5e67eb3ada1ce9f836ca43bde1c216 (diff)
parent78374f18a4199081db4462452b16c3e4193edc92 (diff)
downloadtcl-944a3d95ffd92e872e30021a6b4bc7d932759c22.zip
tcl-944a3d95ffd92e872e30021a6b4bc7d932759c22.tar.gz
tcl-944a3d95ffd92e872e30021a6b4bc7d932759c22.tar.bz2
Rebase back to 8.7 (core-8-branch), since that's what the TIP is meant for. (I see no reason to wait for 9.0)
-rw-r--r--.project2
-rw-r--r--README2
-rw-r--r--doc/GetInt.37
-rw-r--r--doc/Interp.313
-rw-r--r--doc/SaveResult.34
-rw-r--r--doc/SetResult.313
-rw-r--r--doc/expr.n4
-rw-r--r--doc/scan.n6
-rw-r--r--generic/tcl.h65
-rw-r--r--generic/tclBasic.c111
-rw-r--r--generic/tclDecls.h10
-rw-r--r--generic/tclExecute.c14
-rw-r--r--generic/tclHistory.c7
-rw-r--r--generic/tclInt.h76
-rw-r--r--generic/tclListObj.c593
-rw-r--r--generic/tclLoad.c11
-rw-r--r--generic/tclObj.c31
-rw-r--r--generic/tclResult.c375
-rw-r--r--[-rwxr-xr-x]generic/tclStrToD.c65
-rw-r--r--generic/tclStubLib.c4
-rw-r--r--generic/tclTest.c8
-rw-r--r--generic/tclUtil.c185
-rw-r--r--generic/tclVar.c12
-rw-r--r--library/init.tcl2
-rw-r--r--library/safe.tcl2
-rw-r--r--macosx/README6
-rw-r--r--macosx/Tcl-Common.xcconfig2
-rw-r--r--tests/assemble.test2
-rw-r--r--tests/compExpr-old.test24
-rw-r--r--tests/compile.test2
-rw-r--r--tests/execute.test22
-rw-r--r--tests/expr-old.test64
-rw-r--r--tests/expr.test46
-rw-r--r--tests/get.test8
-rw-r--r--tests/lindex.test16
-rw-r--r--tests/mathop.test194
-rw-r--r--tests/namespace-old.test24
-rw-r--r--tests/namespace.test36
-rw-r--r--tests/parse.test6
-rw-r--r--tests/result.test4
-rw-r--r--tests/string.test4
-rw-r--r--tests/stringComp.test4
-rw-r--r--tests/tcltest.test1
-rw-r--r--tests/var.test9
-rw-r--r--tests/while-old.test2
-rw-r--r--tests/while.test4
-rw-r--r--tools/README2
-rwxr-xr-xtools/checkLibraryDoc.tcl4
-rwxr-xr-xtools/configure2
-rw-r--r--tools/configure.ac2
-rw-r--r--tools/tcl.hpj.in4
-rwxr-xr-xtools/tcltk-man2html.tcl4
-rw-r--r--unix/Makefile.in14
-rwxr-xr-xunix/configure26
-rw-r--r--unix/configure.ac10
-rw-r--r--unix/tcl.spec2
-rw-r--r--win/Makefile.in14
-rw-r--r--win/README8
-rwxr-xr-xwin/configure8
-rw-r--r--win/configure.ac8
-rw-r--r--win/makefile.vc26
-rw-r--r--win/tcl.hpj.in4
-rw-r--r--win/tcl.m48
63 files changed, 1500 insertions, 748 deletions
diff --git a/.project b/.project
index f274ff9..eddd834 100644
--- a/.project
+++ b/.project
@@ -1,6 +1,6 @@
<?xml version="1.0" encoding="UTF-8"?>
<projectDescription>
- <name>tcl9</name>
+ <name>tcl8</name>
<comment></comment>
<projects>
</projects>
diff --git a/README b/README
index 2a3b597..322666a 100644
--- a/README
+++ b/README
@@ -1,5 +1,5 @@
README: Tcl
- This is the Tcl 9.0a0 source distribution.
+ This is the Tcl 8.7a2 source distribution.
http://sourceforge.net/projects/tcl/files/Tcl/
You can get any source release of Tcl from the URL above.
diff --git a/doc/GetInt.3 b/doc/GetInt.3
index 5562e28..eba549d 100644
--- a/doc/GetInt.3
+++ b/doc/GetInt.3
@@ -64,9 +64,12 @@ if the first such characters are
then \fIsrc\fR is expected to be in octal form; otherwise,
if the first such characters are
.QW \fB0b\fR
+then \fIsrc\fR is expected to be in binary form; otherwise,
+if the first such character is
+.QW \fB0\fR
then \fIsrc\fR
-is expected to be in binary form; otherwise, \fIsrc\fR is
-expected to be in decimal form.
+is expected to be in octal form; otherwise, \fIsrc\fR
+is expected to be in decimal form.
.PP
\fBTcl_GetDouble\fR expects \fIsrc\fR to consist of a floating-point
number, which is: white space; a sign; a sequence of digits; a
diff --git a/doc/Interp.3 b/doc/Interp.3
index daf76fb..731007b 100644
--- a/doc/Interp.3
+++ b/doc/Interp.3
@@ -33,6 +33,19 @@ the pointer as described below is no longer supported. The supported
public routines \fBTcl_SetResult\fR, \fBTcl_GetResult\fR,
\fBTcl_SetErrorLine\fR, \fBTcl_GetErrorLine\fR must be used instead.
.PP
+For legacy programs and extensions no longer being maintained, compiles
+against the Tcl 8.6 header files are only possible with the compiler
+directives
+.CS
+#define USE_INTERP_RESULT
+.CE
+and/or
+.CS
+#define USE_INTERP_ERRORLINE
+.CE
+depending on which fields of the \fBTcl_Interp\fR struct are accessed.
+These directives may be embedded in code or supplied via compiler options.
+.PP
The \fIresult\fR and \fIfreeProc\fR fields are used to return
results or error messages from commands.
This information is returned by command procedures back to \fBTcl_Eval\fR,
diff --git a/doc/SaveResult.3 b/doc/SaveResult.3
index 6dd6cb6..b2270a2 100644
--- a/doc/SaveResult.3
+++ b/doc/SaveResult.3
@@ -54,9 +54,9 @@ is called, Tcl will take care of memory management.
.PP
The second triplet stores the snapshot of only the interpreter
result (not its complete state) in memory allocated by the caller.
-These routines are passed a pointer to \fBTcl_SavedResult\fR
+These routines are passed a pointer to a \fBTcl_SavedResult\fR structure
that is used to store enough information to restore the interpreter result.
-\fBTcl_SavedResult\fR can be allocated on the stack of the calling
+This structure can be allocated on the stack of the calling
procedure. These routines do not save the state of any error
information in the interpreter (e.g. the \fB\-errorcode\fR or
\fB\-errorinfo\fR return options, when an error is in progress).
diff --git a/doc/SetResult.3 b/doc/SetResult.3
index 545787c..e5b81d7 100644
--- a/doc/SetResult.3
+++ b/doc/SetResult.3
@@ -197,6 +197,19 @@ It also sets \fIinterp->freeProc\fR to zero, but does not
change \fIinterp->result\fR or clear error state.
\fBTcl_FreeResult\fR is most commonly used when a procedure
is about to replace one result value with another.
+.SS "DIRECT ACCESS TO INTERP->RESULT"
+.PP
+It used to be legal for programs to
+directly read and write \fIinterp->result\fR
+to manipulate the interpreter result. The Tcl headers no longer
+permit this access by default, and C code still doing this must
+be updated to use supported routines \fBTcl_GetObjResult\fR,
+\fBTcl_GetStringResult\fR, \fBTcl_SetObjResult\fR, and \fBTcl_SetResult\fR.
+As a migration aid, access can be restored with the compiler directive
+.CS
+#define USE_INTERP_RESULT
+.CE
+but this is meant only to offer life support to otherwise dead code.
.SH "THE TCL_FREEPROC ARGUMENT TO TCL_SETRESULT"
.PP
\fBTcl_SetResult\fR's \fIfreeProc\fR argument specifies how
diff --git a/doc/expr.n b/doc/expr.n
index 9cb1625..d33623c 100644
--- a/doc/expr.n
+++ b/doc/expr.n
@@ -50,7 +50,9 @@ An integer operand may be specified in decimal (the normal case, the optional
first two characters are \fB0d\fR), binary
(the first two characters are \fB0b\fR), octal
(the first two characters are \fB0o\fR), or hexadecimal
-(the first two characters are \fB0x\fR) form.
+(the first two characters are \fB0x\fR) form. For
+compatibility with older Tcl releases, an operand that begins with \fB0\fR is
+interpreted as an octal integer even if the second character is not \fBo\fR.
A floating-point number may be specified in any of several
common decimal formats, and may use the decimal point \fB.\fR,
\fBe\fR or \fBE\fR for scientific notation, and
diff --git a/doc/scan.n b/doc/scan.n
index e87bef1..0c24fea 100644
--- a/doc/scan.n
+++ b/doc/scan.n
@@ -224,10 +224,12 @@ set string "#08D03F"
\fBscan\fR $string "#%2x%2x%2x" r g b
.CE
.PP
-Parse a \fIHH:MM\fR time string:
+Parse a \fIHH:MM\fR time string, noting that this avoids problems with
+octal numbers by forcing interpretation as decimals (if we did not
+care, we would use the \fB%i\fR conversion instead):
.PP
.CS
-set string "08:08"
+set string "08:08" ;# *Not* octal!
if {[\fBscan\fR $string "%d:%d" hours minutes] != 2} {
error "not a valid time string"
}
diff --git a/generic/tcl.h b/generic/tcl.h
index d261b02..a6a8c94 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -52,13 +52,13 @@ extern "C" {
* tools/tcl.hpj.in (not patchlevel, for windows installer)
*/
-#define TCL_MAJOR_VERSION 9
-#define TCL_MINOR_VERSION 0
+#define TCL_MAJOR_VERSION 8
+#define TCL_MINOR_VERSION 7
#define TCL_RELEASE_LEVEL TCL_ALPHA_RELEASE
-#define TCL_RELEASE_SERIAL 0
+#define TCL_RELEASE_SERIAL 2
-#define TCL_VERSION "9.0"
-#define TCL_PATCH_LEVEL "9.0a0"
+#define TCL_VERSION "8.7"
+#define TCL_PATCH_LEVEL "8.7a2"
#if !defined(TCL_NO_DEPRECATED) || defined(RC_INVOKED)
/*
@@ -492,7 +492,39 @@ typedef unsigned TCL_WIDE_INT_TYPE Tcl_WideUInt;
* accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
*/
-typedef struct Tcl_Interp Tcl_Interp;
+typedef struct Tcl_Interp
+#ifndef TCL_NO_DEPRECATED
+{
+ /* TIP #330: Strongly discourage extensions from using the string
+ * result. */
+#ifdef USE_INTERP_RESULT
+ char *result TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
+ /* If the last command returned a string
+ * result, this points to it. */
+ void (*freeProc) (char *blockPtr)
+ TCL_DEPRECATED_API("use Tcl_GetStringResult/Tcl_SetResult");
+ /* Zero means the string result is statically
+ * allocated. TCL_DYNAMIC means it was
+ * allocated with ckalloc and should be freed
+ * with ckfree. Other values give the address
+ * of function to invoke to free the result.
+ * Tcl_Eval must free it before executing next
+ * command. */
+#else
+ char *resultDontUse; /* Don't use in extensions! */
+ void (*freeProcDontUse) (char *); /* Don't use in extensions! */
+#endif
+#ifdef USE_INTERP_ERRORLINE
+ int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
+ /* When TCL_ERROR is returned, this gives the
+ * line number within the command where the
+ * error occurred (1 if first line). */
+#else
+ int errorLineDontUse; /* Don't use in extensions! */
+#endif
+}
+#endif /* !TCL_NO_DEPRECATED */
+Tcl_Interp;
typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
@@ -641,6 +673,8 @@ typedef struct stat *Tcl_OldStat_;
#define TCL_BREAK 3
#define TCL_CONTINUE 4
+#define TCL_RESULT_SIZE 200
+
/*
*----------------------------------------------------------------------------
* Flags to control what substitutions are performed by Tcl_SubstObj():
@@ -825,11 +859,20 @@ int Tcl_IsShared(Tcl_Obj *objPtr);
/*
*----------------------------------------------------------------------------
- * The following type contains the state needed by Tcl_SaveResult. It
- * is typically allocated on the stack.
- */
-
-typedef Tcl_Obj *Tcl_SavedResult;
+ * The following structure contains the state needed by Tcl_SaveResult. No-one
+ * outside of Tcl should access any of these fields. This structure is
+ * typically allocated on the stack.
+ */
+
+typedef struct Tcl_SavedResult {
+ char *result;
+ Tcl_FreeProc *freeProc;
+ Tcl_Obj *objResultPtr;
+ char *appendResult;
+ int appendAvl;
+ int appendUsed;
+ char resultSpace[TCL_RESULT_SIZE+1];
+} Tcl_SavedResult;
/*
*----------------------------------------------------------------------------
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2c84e63..f84b420 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -510,12 +510,13 @@ Tcl_CreateInterp(void)
iPtr = ckalloc(sizeof(Interp));
interp = (Tcl_Interp *) iPtr;
- iPtr->legacyResult = NULL;
- /* Special invalid value: Any attempt to free the legacy result
- * will cause a crash. */
- iPtr->legacyFreeProc = (void (*) (void))-1;
+#ifdef TCL_NO_DEPRECATED
+ iPtr->result = &tclEmptyString;
+#else
+ iPtr->result = iPtr->resultSpace;
+#endif
+ iPtr->freeProc = NULL;
iPtr->errorLine = 0;
- iPtr->stubTable = &tclStubs;
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
iPtr->handle = TclHandleCreate(iPtr);
@@ -573,6 +574,12 @@ Tcl_CreateInterp(void)
iPtr->rootFramePtr = NULL; /* Initialise as soon as :: is available */
iPtr->lookupNsPtr = NULL;
+#ifndef TCL_NO_DEPRECATED
+ iPtr->appendResult = NULL;
+ iPtr->appendAvl = 0;
+ iPtr->appendUsed = 0;
+#endif
+
Tcl_InitHashTable(&iPtr->packageTable, TCL_STRING_KEYS);
iPtr->packageUnknown = NULL;
@@ -601,6 +608,9 @@ Tcl_CreateInterp(void)
iPtr->emptyObjPtr = Tcl_NewObj();
/* Another empty object. */
Tcl_IncrRefCount(iPtr->emptyObjPtr);
+#ifndef TCL_NO_DEPRECATED
+ iPtr->resultSpace[0] = 0;
+#endif
iPtr->threadId = Tcl_GetCurrentThread();
/* TIP #378 */
@@ -711,6 +721,12 @@ Tcl_CreateInterp(void)
#endif /* TCL_COMPILE_STATS */
/*
+ * Initialise the stub table pointer.
+ */
+
+ iPtr->stubTable = &tclStubs;
+
+ /*
* Initialize the ensemble error message rewriting support.
*/
@@ -1505,6 +1521,7 @@ DeleteInterpProc(
*/
Tcl_FreeResult(interp);
+ iPtr->result = NULL;
Tcl_DecrRefCount(iPtr->objResultPtr);
iPtr->objResultPtr = NULL;
Tcl_DecrRefCount(iPtr->ecVar);
@@ -1526,6 +1543,12 @@ DeleteInterpProc(
if (iPtr->returnOpts) {
Tcl_DecrRefCount(iPtr->returnOpts);
}
+#ifndef TCL_NO_DEPRECATED
+ if (iPtr->appendResult != NULL) {
+ ckfree(iPtr->appendResult);
+ iPtr->appendResult = NULL;
+ }
+#endif
TclFreePackageInfo(iPtr);
while (iPtr->tracePtr != NULL) {
Tcl_DeleteTrace((Tcl_Interp *) iPtr, (Tcl_Trace) iPtr->tracePtr);
@@ -2459,7 +2482,7 @@ TclInvokeStringCommand(
* in the Command structure.
*
* Results:
- * A standard Tcl result value.
+ * A standard Tcl string result value.
*
* Side effects:
* Besides those side effects of the called Tcl_ObjCmdProc,
@@ -2500,6 +2523,13 @@ TclInvokeObjectCommand(
}
/*
+ * Move the interpreter's object result to the string result, then reset
+ * the object result.
+ */
+
+ (void) Tcl_GetStringResult(interp);
+
+ /*
* Decrement the ref counts for the argument objects created above, then
* free the objv array if malloc'ed storage was used.
*/
@@ -3553,6 +3583,7 @@ OldMathFuncProc(
Tcl_SetObjResult(interp, Tcl_NewStringObj(
"argument to math function didn't have numeric value",
-1));
+ TclCheckBadOctal(interp, TclGetString(valuePtr));
ckfree(args);
return TCL_ERROR;
}
@@ -3802,7 +3833,7 @@ Tcl_ListMathFuncs(
* otherwise.
*
* Side effects:
- * The interpreter's result is cleared.
+ * The interpreters object and string results are cleared.
*
*----------------------------------------------------------------------
*/
@@ -3814,8 +3845,8 @@ TclInterpReady(
register Interp *iPtr = (Interp *) interp;
/*
- * Reset the interpreter's result and clear out any previous error
- * information.
+ * Reset both the interpreter's string and object results and clear out
+ * any previous error information.
*/
Tcl_ResetResult(interp);
@@ -4395,9 +4426,24 @@ TclNRRunCallbacks(
/* All callbacks down to rootPtr not inclusive
* are to be run. */
{
+ Interp *iPtr = (Interp *) interp;
NRE_callback *callbackPtr;
Tcl_NRPostProc *procPtr;
+ /*
+ * If the interpreter has a non-empty string result, the result object is
+ * either empty or stale because some function set interp->result
+ * directly. If so, move the string result to the result object, then
+ * reset the string result.
+ *
+ * This only needs to be done for the first item in the list: all other
+ * are for NR function calls, and those are Tcl_Obj based.
+ */
+
+ if (*(iPtr->result) != 0) {
+ (void) Tcl_GetObjResult(interp);
+ }
+
while (TOP_CB(interp) != rootPtr) {
callbackPtr = TOP_CB(interp);
procPtr = callbackPtr->procPtr;
@@ -5865,7 +5911,16 @@ Tcl_Eval(
* previous call to Tcl_CreateInterp). */
const char *script) /* Pointer to TCL command to execute. */
{
- return Tcl_EvalEx(interp, script, -1, 0);
+ int code = Tcl_EvalEx(interp, script, -1, 0);
+
+ /*
+ * For backwards compatibility with old C code that predates the object
+ * system in Tcl 8.0, we have to mirror the object result back into the
+ * string result (some callers may expect it there).
+ */
+
+ (void) Tcl_GetStringResult(interp);
+ return code;
}
/*
@@ -6288,6 +6343,9 @@ Tcl_ExprLong(
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprLongObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
+ if (result != TCL_OK) {
+ (void) Tcl_GetStringResult(interp);
+ }
}
return result;
}
@@ -6314,6 +6372,9 @@ Tcl_ExprDouble(
result = Tcl_ExprDoubleObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
/* Discard the expression object. */
+ if (result != TCL_OK) {
+ (void) Tcl_GetStringResult(interp);
+ }
}
return result;
}
@@ -6339,6 +6400,14 @@ Tcl_ExprBoolean(
Tcl_IncrRefCount(exprPtr);
result = Tcl_ExprBooleanObj(interp, exprPtr, ptr);
Tcl_DecrRefCount(exprPtr);
+ if (result != TCL_OK) {
+ /*
+ * Move the interpreter's object result to the string result, then
+ * reset the object result.
+ */
+
+ (void) Tcl_GetStringResult(interp);
+ }
return result;
}
}
@@ -6652,6 +6721,12 @@ Tcl_ExprString(
Tcl_DecrRefCount(resultPtr);
}
}
+
+ /*
+ * Force the string rep of the interp result.
+ */
+
+ (void) Tcl_GetStringResult(interp);
return code;
}
@@ -6758,7 +6833,19 @@ Tcl_AddObjErrorInfo(
iPtr->flags |= ERR_LEGACY_COPY;
if (iPtr->errorInfo == NULL) {
- iPtr->errorInfo = iPtr->objResultPtr;
+ if (iPtr->result[0] != 0) {
+ /*
+ * The interp's string result is set, apparently by some extension
+ * making a deprecated direct write to it. That extension may
+ * expect interp->result to continue to be set, so we'll take
+ * special pains to avoid clearing it, until we drop support for
+ * interp->result completely.
+ */
+
+ iPtr->errorInfo = Tcl_NewStringObj(iPtr->result, -1);
+ } else {
+ iPtr->errorInfo = iPtr->objResultPtr;
+ }
Tcl_IncrRefCount(iPtr->errorInfo);
if (!iPtr->errorCode) {
Tcl_SetErrorCode(interp, "NONE", NULL);
@@ -6836,7 +6923,7 @@ Tcl_VarEvalVA(
*
* Results:
* A standard Tcl return result. An error message or other result may be
- * left in the interp.
+ * left in interp->result.
*
* Side effects:
* Depends on what was done by the command.
diff --git a/generic/tclDecls.h b/generic/tclDecls.h
index 17d60a8..464fc0f 100644
--- a/generic/tclDecls.h
+++ b/generic/tclDecls.h
@@ -3888,20 +3888,20 @@ extern const TclStubs *tclStubsPtr;
#undef Tcl_SaveResult
#define Tcl_SaveResult(interp, statePtr) \
do { \
- *(statePtr) = Tcl_GetObjResult(interp); \
- Tcl_IncrRefCount(*(statePtr)); \
+ (statePtr)->objResultPtr = Tcl_GetObjResult(interp); \
+ Tcl_IncrRefCount((statePtr)->objResultPtr); \
Tcl_SetObjResult(interp, Tcl_NewObj()); \
} while(0)
#undef Tcl_RestoreResult
#define Tcl_RestoreResult(interp, statePtr) \
do { \
Tcl_ResetResult(interp); \
- Tcl_SetObjResult(interp, *(statePtr)); \
- Tcl_DecrRefCount(*(statePtr)); \
+ Tcl_SetObjResult(interp, (statePtr)->objResultPtr); \
+ Tcl_DecrRefCount((statePtr)->objResultPtr); \
} while(0)
#undef Tcl_DiscardResult
#define Tcl_DiscardResult(statePtr) \
- Tcl_DecrRefCount(*(statePtr))
+ Tcl_DecrRefCount((statePtr)->objResultPtr)
#undef Tcl_SetResult
#define Tcl_SetResult(interp, result, freeProc) \
do { \
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 46bcb8c..b08da3e 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -9272,7 +9272,16 @@ IllegalExprOperandType(
}
if (GetNumberFromObj(NULL, opndPtr, &ptr, &type) != TCL_OK) {
- description = "non-numeric string";
+ int numBytes;
+ const char *bytes = TclGetStringFromObj(opndPtr, &numBytes);
+
+ if (numBytes == 0) {
+ description = "empty string";
+ } else if (TclCheckBadOctal(NULL, bytes)) {
+ description = "invalid octal number";
+ } else {
+ description = "non-numeric string";
+ }
} else if (type == TCL_NUMBER_NAN) {
description = "non-numeric floating-point value";
} else if (type == TCL_NUMBER_DOUBLE) {
@@ -9283,8 +9292,7 @@ IllegalExprOperandType(
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "can't use %s \"%s\" as operand of \"%s\"", description,
- Tcl_GetString(opndPtr), operator));
+ "can't use %s as operand of \"%s\"", description, operator));
Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", description, NULL);
}
diff --git a/generic/tclHistory.c b/generic/tclHistory.c
index 0c8201a..47806d4 100644
--- a/generic/tclHistory.c
+++ b/generic/tclHistory.c
@@ -74,6 +74,13 @@ Tcl_RecordAndEval(
result = Tcl_RecordAndEvalObj(interp, cmdPtr, flags);
/*
+ * Move the interpreter's object result to the string result, then
+ * reset the object result.
+ */
+
+ (void) Tcl_GetStringResult(interp);
+
+ /*
* Discard the Tcl object created to hold the command.
*/
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 17e5c87..24a03ff 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1773,31 +1773,41 @@ typedef struct AllocCache {
typedef struct Interp {
/*
- * The first two fields were named "result" and "freeProc" in earlier
- * versions of Tcl. They are no longer used within Tcl, and are no
- * longer available to be accessed by extensions. However, they cannot
- * be removed. Why? There is a deployed base of stub-enabled extensions
- * that query the value of iPtr->stubTable. For them to continue to work,
- * the location of the field "stubTable" within the Interp struct cannot
- * change. The most robust way to assure that is to leave all fields up to
- * that one undisturbed.
+ * Note: the first three fields must match exactly the fields in a
+ * Tcl_Interp struct (see tcl.h). If you change one, be sure to change the
+ * other.
+ *
+ * The interpreter's result is held in both the string and the
+ * objResultPtr fields. These fields hold, respectively, the result's
+ * string or object value. The interpreter's result is always in the
+ * result field if that is non-empty, otherwise it is in objResultPtr.
+ * The two fields are kept consistent unless some C code sets
+ * interp->result directly. Programs should not access result and
+ * objResultPtr directly; instead, they should always get and set the
+ * result using procedures such as Tcl_SetObjResult, Tcl_GetObjResult, and
+ * Tcl_GetStringResult. See the SetResult man page for details.
*/
- const char *legacyResult;
- void (*legacyFreeProc) (void);
+ char *result; /* If the last command returned a string
+ * result, this points to it. Should not be
+ * accessed directly; see comment above. */
+ Tcl_FreeProc *freeProc; /* Zero means a string result is statically
+ * allocated. TCL_DYNAMIC means string result
+ * was allocated with ckalloc and should be
+ * freed with ckfree. Other values give
+ * address of procedure to invoke to free the
+ * string result. Tcl_Eval must free it before
+ * executing next command. */
int errorLine; /* When TCL_ERROR is returned, this gives the
* line number in the command where the error
* occurred (1 means first line). */
const struct TclStubs *stubTable;
- /* Pointer to the exported Tcl stub table. In
- * ancient pre-8.1 versions of Tcl this was a
- * pointer to the objResultPtr or a pointer to a
- * buckets array in a hash table. Deployed stubs
- * enabled extensions check for a NULL pointer value
- * and for a TCL_STUBS_MAGIC value to verify they
- * are not [load]ing into one of those pre-stubs
- * interps.
- */
+ /* Pointer to the exported Tcl stub table. On
+ * previous versions of Tcl this is a pointer
+ * to the objResultPtr or a pointer to a
+ * buckets array in a hash table. We therefore
+ * have to do some careful checking before we
+ * can use this. */
TclHandle handle; /* Handle used to keep track of when this
* interp is deleted. */
@@ -1848,6 +1858,25 @@ typedef struct Interp {
* TCL_EVAL_INVOKE call to Tcl_EvalObjv. */
/*
+ * Information used by Tcl_AppendResult to keep track of partial results.
+ * See Tcl_AppendResult code for details.
+ */
+
+#ifndef TCL_NO_DEPRECATED
+ char *appendResult; /* Storage space for results generated by
+ * Tcl_AppendResult. Ckalloc-ed. NULL means
+ * not yet allocated. */
+ int appendAvl; /* Total amount of space available at
+ * partialResult. */
+ int appendUsed; /* Number of non-null bytes currently stored
+ * at partialResult. */
+#else
+ char *appendResultDontUse;
+ int appendAvlDontUse;
+ int appendUsedDontUse;
+#endif
+
+ /*
* Information about packages. Used only in tclPkg.c.
*/
@@ -1869,6 +1898,7 @@ typedef struct Interp {
* Normally zero, but may be set before
* calling Tcl_Eval. See below for valid
* values. */
+ int unused1; /* No longer used (was termOffset) */
LiteralTable literalTable; /* Contains LiteralEntry's describing all Tcl
* objects holding literals of scripts
* compiled by the interpreter. Indexed by the
@@ -1906,6 +1936,12 @@ typedef struct Interp {
* string. Returned by Tcl_ObjSetVar2 when
* variable traces change a variable in a
* gross way. */
+#ifndef TCL_NO_DEPRECATED
+ char resultSpace[TCL_RESULT_SIZE+1];
+ /* Static space holding small results. */
+#else
+ char resultSpaceDontUse[TCL_RESULT_SIZE+1];
+#endif
Tcl_Obj *objResultPtr; /* If the last command returned an object
* result, this points to it. Should not be
* accessed directly; see comment above. */
@@ -2851,6 +2887,8 @@ MODULE_SCOPE int TclByteArrayMatch(const unsigned char *string,
MODULE_SCOPE double TclCeil(const mp_int *a);
MODULE_SCOPE void TclChannelPreserve(Tcl_Channel chan);
MODULE_SCOPE void TclChannelRelease(Tcl_Channel chan);
+MODULE_SCOPE int TclCheckBadOctal(Tcl_Interp *interp,
+ const char *value);
MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp,
Tcl_Channel chan);
MODULE_SCOPE Tcl_ObjCmdProc TclChannelNamesCmd;
diff --git a/generic/tclListObj.c b/generic/tclListObj.c
index f94433b..11374cc 100644
--- a/generic/tclListObj.c
+++ b/generic/tclListObj.c
@@ -55,22 +55,20 @@ const Tcl_ObjType tclListType = {
*
* NewListIntRep --
*
- * Creates a 'List' structure with space for 'objc' elements. 'objc' must
- * be > 0. If 'objv' is not NULL, The list is initialized with first
- * 'objc' values in that array. Otherwise the list is initialized to have
- * 0 elements, with space to add 'objc' more. Flag value 'p' indicates
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more. Flag value "p" indicates
* how to behave on failure.
*
- * Value
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then if p=0, NULL is returned and otherwise the
+ * routine panics.
*
- * A new 'List' structure with refCount 0. If some failure
- * prevents this NULL is returned if 'p' is 0 , and 'Tcl_Panic'
- * is called if it is not.
- *
- * Effect
- *
- * The refCount of each value in 'objv' is incremented as it is added
- * to the list.
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
@@ -134,10 +132,22 @@ NewListIntRep(
/*
*----------------------------------------------------------------------
*
- * AttemptNewList --
+ * AttemptNewList --
+ *
+ * Creates a list internal rep with space for objc elements. objc
+ * must be > 0. If objv!=NULL, initializes with the first objc values
+ * in that array. If objv==NULL, initalize list internal rep to have
+ * 0 elements, with space to add objc more.
+ *
+ * Results:
+ * A new List struct with refCount 0 is returned. If some failure
+ * prevents this then NULL is returned, and an error message is left
+ * in the interp result, unless interp is NULL.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
- * Like NewListIntRep, but additionally sets an error message on failure.
- *
*----------------------------------------------------------------------
*/
@@ -169,20 +179,23 @@ AttemptNewList(
*
* Tcl_NewListObj --
*
- * Creates a new list object and adds values to it. When TCL_MEM_DEBUG is
- * defined, 'Tcl_DbNewListObj' is called instead.
+ * This function is normally called when not debugging: i.e., when
+ * TCL_MEM_DEBUG is not defined. It creates a new list object from an
+ * (objc,objv) array: that is, each of the objc elements of the array
+ * referenced by objv is inserted as an element into a new Tcl object.
*
- * Value
+ * When TCL_MEM_DEBUG is defined, this function just returns the result
+ * of calling the debugging version Tcl_DbNewListObj.
*
- * A new list 'Tcl_Obj' to which is appended values from 'objv', or if
- * 'objc' is less than or equal to zero, a list 'Tcl_Obj' having no
- * elements. The string representation of the new 'Tcl_Obj' is set to
- * NULL. The refCount of the list is 0.
+ * Results:
+ * A new list object is returned that is initialized from the object
+ * pointers in objv. If objc is less than or equal to zero, an empty
+ * object is returned. The new object's string representation is left
+ * NULL. The resulting new list object has ref count 0.
*
- * Effect
- *
- * The refCount of each elements in 'objv' is incremented as it is added
- * to the list.
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
@@ -233,14 +246,28 @@ Tcl_NewListObj(
/*
*----------------------------------------------------------------------
*
- * Tcl_DbNewListObj --
- *
- * Like 'Tcl_NewListObj', but it calls Tcl_DbCkalloc directly with the
- * file name and line number from its caller. This simplifies debugging
- * since the [memory active] command will report the correct file
- * name and line number when reporting objects that haven't been freed.
- *
- * When TCL_MEM_DEBUG is not defined, 'Tcl_NewListObj' is called instead.
+ * Tcl_DbNewListObj --
+ *
+ * This function is normally called when debugging: i.e., when
+ * TCL_MEM_DEBUG is defined. It creates new list objects. It is the same
+ * as the Tcl_NewListObj function above except that it calls
+ * Tcl_DbCkalloc directly with the file name and line number from its
+ * caller. This simplifies debugging since then the [memory active]
+ * command will report the correct file name and line number when
+ * reporting objects that haven't been freed.
+ *
+ * When TCL_MEM_DEBUG is not defined, this function just returns the
+ * result of calling Tcl_NewListObj.
+ *
+ * Results:
+ * A new list object is returned that is initialized from the object
+ * pointers in objv. If objc is less than or equal to zero, an empty
+ * object is returned. The new object's string representation is left
+ * NULL. The new list object has ref count 0.
+ *
+ * Side effects:
+ * The ref counts of the elements in objv are incremented since the
+ * resulting list now refers to them.
*
*----------------------------------------------------------------------
*/
@@ -301,8 +328,19 @@ Tcl_DbNewListObj(
*
* Tcl_SetListObj --
*
- * Like 'Tcl_NewListObj', but operates on an existing 'Tcl_Obj'instead of
- * creating a new one.
+ * Modify an object to be a list containing each of the objc elements of
+ * the object array referenced by objv.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object is made a list object and is initialized from the object
+ * pointers in objv. If objc is less than or equal to zero, an empty
+ * object is returned. The new object's string representation is left
+ * NULL. The ref counts of the elements in objv are incremented since the
+ * list now refers to them. The object's old string and internal
+ * representations are freed and its type is set NULL.
*
*----------------------------------------------------------------------
*/
@@ -346,20 +384,18 @@ Tcl_SetListObj(
*
* TclListObjCopy --
*
- * Creates a new 'Tcl_Obj' which is a pure copy of a list value. This
- * provides for the C level a counterpart of the [lrange $list 0 end]
- * command, while using internals details to be as efficient as possible.
- *
- * Value
+ * Makes a "pure list" copy of a list value. This provides for the C
+ * level a counterpart of the [lrange $list 0 end] command, while using
+ * internals details to be as efficient as possible.
*
- * The address of the new 'Tcl_Obj' which shares its internal
- * representation with 'listPtr', and whose refCount is 0. If 'listPtr'
- * is not actually a list, the value is NULL, and an error message is left
- * in 'interp' if it is not NULL.
+ * Results:
+ * Normally returns a pointer to a new Tcl_Obj, that contains the same
+ * list value as *listPtr does. The returned Tcl_Obj has a refCount of
+ * zero. If *listPtr does not hold a list, NULL is returned, and if
+ * interp is non-NULL, an error message is recorded there.
*
- * Effect
- *
- * 'listPtr' is converted to a list if it isn't one already.
+ * Side effects:
+ * None.
*
*----------------------------------------------------------------------
*/
@@ -389,30 +425,27 @@ TclListObjCopy(
*
* Tcl_ListObjGetElements --
*
- * Retreive the elements in a list 'Tcl_Obj'.
- *
- * Value
- *
- * TCL_OK
- *
- * A count of list elements is stored, 'objcPtr', And a pointer to the
- * array of elements in the list is stored in 'objvPtr'.
+ * This function returns an (objc,objv) array of the elements in a list
+ * object.
*
- * The elements accessible via 'objvPtr' should be treated as readonly
- * and the refCount for each object is _not_ incremented; the caller
- * must do that if it holds on to a reference. Furthermore, the
- * pointer and length returned by this function may change as soon as
- * any function is called on the list object. Be careful about
- * retaining the pointer in a local data structure.
+ * Results:
+ * The return value is normally TCL_OK; in this case *objcPtr is set to
+ * the count of list elements and *objvPtr is set to a pointer to an
+ * array of (*objcPtr) pointers to each list element. If listPtr does not
+ * refer to a list object and the object can not be converted to one,
+ * TCL_ERROR is returned and an error message will be left in the
+ * interpreter's result if interp is not NULL.
*
- * TCL_ERROR
+ * The objects referenced by the returned array should be treated as
+ * readonly and their ref counts are _not_ incremented; the caller must
+ * do that if it holds on to a reference. Furthermore, the pointer and
+ * length returned by this function may change as soon as any function is
+ * called on the list object; be careful about retaining the pointer in a
+ * local data structure.
*
- * 'listPtr' is not a valid list. An error message is left in the
- * interpreter's result if 'interp' is not NULL.
- *
- * Effect
- *
- * 'listPtr' is converted to a list object if it isn't one already.
+ * Side effects:
+ * The possible conversion of the object referenced by listPtr
+ * to a list object.
*
*----------------------------------------------------------------------
*/
@@ -453,27 +486,20 @@ Tcl_ListObjGetElements(
*
* Tcl_ListObjAppendList --
*
- * Appends the elements of elemListPtr to those of listPtr.
- *
- * Value
- *
- * TCL_OK
- *
- * Success.
+ * This function appends the elements in the list value referenced by
+ * elemListPtr to the list value referenced by listPtr.
*
- * TCL_ERROR
+ * Results:
+ * The return value is normally TCL_OK. If listPtr or elemListPtr do not
+ * refer to list values, TCL_ERROR is returned and an error message is
+ * left in the interpreter's result if interp is not NULL.
*
- * 'listPtr' or 'elemListPtr' are not valid lists. An error
- * message is left in the interpreter's result if 'interp' is not NULL.
- *
- * Effect
- *
- * The reference count of each element of 'elemListPtr' as it is added to
- * 'listPtr'. 'listPtr' and 'elemListPtr' are converted to 'tclListType'
- * if they are not already. Appending the new elements may cause the
- * array of element pointers in 'listObj' to grow. If any objects are
- * appended to 'listPtr'. Any preexisting string representation of
- * 'listPtr' is invalidated.
+ * Side effects:
+ * The reference counts of the elements in elemListPtr are incremented
+ * since the list now refers to them. listPtr and elemListPtr are
+ * converted, if necessary, to list objects. Also, appending the new
+ * elements may cause listObj's array of element pointers to grow.
+ * listPtr's old string representation, if any, is invalidated.
*
*----------------------------------------------------------------------
*/
@@ -512,27 +538,24 @@ Tcl_ListObjAppendList(
*
* Tcl_ListObjAppendElement --
*
- * Like 'Tcl_ListObjAppendList', but Appends a single value to a list.
- *
- * Value
- *
- * TCL_OK
- *
- * 'objPtr' is appended to the elements of 'listPtr'.
- *
- * TCL_ERROR
- *
- * listPtr does not refer to a list object and the object can not be
- * converted to one. An error message will be left in the
- * interpreter's result if interp is not NULL.
- *
- * Effect
- *
- * If 'listPtr' is not already of type 'tclListType', it is converted.
- * The 'refCount' of 'objPtr' is incremented as it is added to 'listPtr'.
- * Appending the new element may cause the the array of element pointers
- * in 'listObj' to grow. Any preexisting string representation of
- * 'listPtr' is invalidated.
+ * This function is a special purpose version of Tcl_ListObjAppendList:
+ * it appends a single object referenced by objPtr to the list object
+ * referenced by listPtr. If listPtr is not already a list object, an
+ * attempt will be made to convert it to one.
+ *
+ * Results:
+ * The return value is normally TCL_OK; in this case objPtr is added to
+ * the end of listPtr's list. If listPtr does not refer to a list object
+ * and the object can not be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter's result if interp is
+ * not NULL.
+ *
+ * Side effects:
+ * The ref count of objPtr is incremented since the list now refers to
+ * it. listPtr will be converted, if necessary, to a list object. Also,
+ * appending the new element may cause listObj's array of element
+ * pointers to grow. listPtr's old string representation, if any, is
+ * invalidated.
*
*----------------------------------------------------------------------
*/
@@ -683,27 +706,23 @@ Tcl_ListObjAppendElement(
*
* Tcl_ListObjIndex --
*
- * Retrieve a pointer to the element of 'listPtr' at 'index'. The index
- * of the first element is 0.
- *
- * Value
- *
- * TCL_OK
+ * This function returns a pointer to the index'th object from the list
+ * referenced by listPtr. The first element has index 0. If index is
+ * negative or greater than or equal to the number of elements in the
+ * list, a NULL is returned. If listPtr is not a list object, an attempt
+ * will be made to convert it to a list.
*
- * A pointer to the element at 'index' is stored in 'objPtrPtr'. If
- * 'index' is out of range, NULL is stored in 'objPtrPtr'. This
- * object should be treated as readonly and its 'refCount' is _not_
- * incremented. The caller must do that if it holds on to the
- * reference.
- *
- * TCL_ERROR
+ * Results:
+ * The return value is normally TCL_OK; in this case objPtrPtr is set to
+ * the Tcl_Obj pointer for the index'th list element or NULL if index is
+ * out of range. This object should be treated as readonly and its ref
+ * count is _not_ incremented; the caller must do that if it holds on to
+ * the reference. If listPtr does not refer to a list and can't be
+ * converted to one, TCL_ERROR is returned and an error message is left
+ * in the interpreter's result if interp is not NULL.
*
- * 'listPtr' is not a valid list. An an error message is left in the
- * interpreter's result if 'interp' is not NULL.
- *
- * Effect
- *
- * If 'listPtr' is not already of type 'tclListType', it is converted.
+ * Side effects:
+ * listPtr will be converted, if necessary, to a list object.
*
*----------------------------------------------------------------------
*/
@@ -745,20 +764,19 @@ Tcl_ListObjIndex(
*
* Tcl_ListObjLength --
*
- * Retrieve the number of elements in a list.
- *
- * Value
- *
- * TCL_OK
- *
- * A count of list elements is stored at the address provided by
- * 'intPtr'. If 'listPtr' is not already of type 'tclListPtr', it is
- * converted.
+ * This function returns the number of elements in a list object. If the
+ * object is not already a list object, an attempt will be made to
+ * convert it to one.
*
- * TCL_ERROR
+ * Results:
+ * The return value is normally TCL_OK; in this case *intPtr will be set
+ * to the integer count of list elements. If listPtr does not refer to a
+ * list object and the object can not be converted to one, TCL_ERROR is
+ * returned and an error message will be left in the interpreter's result
+ * if interp is not NULL.
*
- * 'listPtr' is not a valid list. An error message will be left in
- * the interpreter's result if 'interp' is not NULL.
+ * Side effects:
+ * The possible conversion of the argument object to a list object.
*
*----------------------------------------------------------------------
*/
@@ -794,36 +812,35 @@ Tcl_ListObjLength(
*
* Tcl_ListObjReplace --
*
- * Replace values in a list.
- *
- * If 'first' is zero or negative, it refers to the first element. If
- * 'first' outside the range of elements in the list, no elements are
- * deleted.
- *
- * If 'count' is zero or negative no elements are deleted, and any new
- * elements are inserted at the beginning of the list.
- *
- * Value
- *
- * TCL_OK
- *
- * The first 'objc' values of 'objv' replaced 'count' elements in 'listPtr'
- * starting at 'first'. If 'objc' 0, no new elements are added.
- *
- * TCL_ERROR
- *
- * 'listPtr' is not a valid list. An error message is left in the
- * interpreter's result if 'interp' is not NULL.
- *
- * Effect
- *
- * If 'listPtr' is not of type 'tclListType', it is converted if possible.
- *
- * The 'refCount' of each element appended to the list is incremented.
- * Similarly, the 'refCount' for each replaced element is decremented.
- *
- * If 'listPtr' is modified, any previous string representation is
- * invalidated.
+ * This function replaces zero or more elements of the list referenced by
+ * listPtr with the objects from an (objc,objv) array. The objc elements
+ * of the array referenced by objv replace the count elements in listPtr
+ * starting at first.
+ *
+ * If the argument first is zero or negative, it refers to the first
+ * element. If first is greater than or equal to the number of elements
+ * in the list, then no elements are deleted; the new elements are
+ * appended to the list. Count gives the number of elements to replace.
+ * If count is zero or negative then no elements are deleted; the new
+ * elements are simply inserted before first.
+ *
+ * The argument objv refers to an array of objc pointers to the new
+ * elements to be added to listPtr in place of those that were deleted.
+ * If objv is NULL, no new elements are added. If listPtr is not a list
+ * object, an attempt will be made to convert it to one.
+ *
+ * Results:
+ * The return value is normally TCL_OK. If listPtr does not refer to a
+ * list object and can not be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter's result if interp is
+ * not NULL.
+ *
+ * Side effects:
+ * The ref counts of the objc elements in objv are incremented since the
+ * resulting list now refers to them. Similarly, the ref counts for
+ * replaced objects are decremented. listPtr is converted, if necessary,
+ * to a list object. listPtr's old string representation, if any, is
+ * freed.
*
*----------------------------------------------------------------------
*/
@@ -1081,19 +1098,22 @@ Tcl_ListObjReplace(
*
* TclLindexList --
*
- * Implements the 'lindex' command when objc==3.
+ * This procedure handles the 'lindex' command when objc==3.
*
- * Implemented entirely as a wrapper around 'TclLindexFlat'. Reconfigures
- * the argument format into required form while taking care to manage
- * shimmering so as to tend to keep the most useful intreps
- * and/or avoid the most expensive conversions.
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
*
- * Value
+ * Side effects:
+ * None.
*
- * A pointer to the specified element, with its 'refCount' incremented, or
- * NULL if an error occurred.
- *
- * Notes
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLindexFlat. All it does is reconfigure the argument format into the
+ * form required by TclLindexFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
*----------------------------------------------------------------------
*/
@@ -1165,20 +1185,25 @@ TclLindexList(
/*
*----------------------------------------------------------------------
*
- * TclLindexFlat --
- *
- * The core of the 'lindex' command, with all index
- * arguments presented as a flat list.
+ * TclLindexFlat --
*
- * Value
+ * This procedure is the core of the 'lindex' command, with all index
+ * arguments presented as a flat list.
*
- * A pointer to the object extracted, with its 'refCount' incremented, or
- * NULL if an error occurred. Thus, the calling code will usually do
- * something like:
+ * Results:
+ * Returns a pointer to the object extracted, or NULL if an error
+ * occurred. The returned object already includes one reference count for
+ * the pointer returned.
*
- * Tcl_SetObjResult(interp, result);
- * Tcl_DecrRefCount(result);
+ * Side effects:
+ * None.
*
+ * Notes:
+ * The reference count of the returned object includes one reference
+ * corresponding to the pointer returned. Thus, the calling code will
+ * usually do something like:
+ * Tcl_SetObjResult(interp, result);
+ * Tcl_DecrRefCount(result);
*
*----------------------------------------------------------------------
*/
@@ -1254,16 +1279,23 @@ TclLindexFlat(
*
* TclLsetList --
*
- * The core of [lset] when objc == 4. Objv[2] may be either a
+ * Core of the 'lset' command when objc == 4. Objv[2] may be either a
* scalar index or a list of indices.
*
- * Implemented entirely as a wrapper around 'TclLindexFlat', as described
- * for 'TclLindexList'.
+ * Results:
+ * Returns the new value of the list variable, or NULL if there was an
+ * error. The returned object includes one reference count for the
+ * pointer returned.
*
- * Value
+ * Side effects:
+ * None.
*
- * The new list, with the 'refCount' of 'valuPtr' incremented, or NULL if
- * there was an error.
+ * Notes:
+ * This procedure is implemented entirely as a wrapper around
+ * TclLsetFlat. All it does is reconfigure the argument format into the
+ * form required by TclLsetFlat, while taking care to manage shimmering
+ * in such a way that we tend to keep the most useful intreps and/or
+ * avoid the most expensive conversions.
*
*----------------------------------------------------------------------
*/
@@ -1325,39 +1357,36 @@ TclLsetList(
*
* Core engine of the 'lset' command.
*
- * Value
- *
- * The resulting list
- *
- * The 'refCount' of 'valuePtr' is incremented. If 'listPtr' was not
- * duplicated, its 'refCount' is incremented. The reference count of
- * an unduplicated object is therefore 2 (one for the returned pointer
- * and one for the variable that holds it). The reference count of a
- * duplicate object is 1, reflecting that result is the only active
- * reference. The caller is expected to store the result in the
- * variable and decrement its reference count. (INST_STORE_* does
- * exactly this.)
- *
- * NULL
- *
- * An error occurred. If 'listPtr' was duplicated, the reference
- * count on the duplicate is decremented so that it is 0, causing any
- * memory allocated by this function to be freed.
- *
- *
- * Effect
- *
- * On entry, the reference count of 'listPtr' does not reflect any
- * references held on the stack. The first action of this function is to
- * determine whether 'listPtr' is shared and to create a duplicate
- * unshared copy if it is. The reference count of the duplicate is
- * incremented. At this point, the reference count is 1 in either case so
- * that the object is considered unshared.
- *
- * The unshared list is altered directly to produce the result.
- * 'TclLsetFlat' maintains a linked list of 'Tcl_Obj' values whose string
+ * Results:
+ * Returns the new value of the list variable, or NULL if an error
+ * occurred. The returned object includes one reference count for the
+ * pointer returned.
+ *
+ * Side effects:
+ * On entry, the reference count of the variable value does not reflect
+ * any references held on the stack. The first action of this function is
+ * to determine whether the object is shared, and to duplicate it if it
+ * is. The reference count of the duplicate is incremented. At this
+ * point, the reference count will be 1 for either case, so that the
+ * object will appear to be unshared.
+ *
+ * If an error occurs, and the object has been duplicated, the reference
+ * count on the duplicate is decremented so that it is now 0: this
+ * dismisses any memory that was allocated by this function.
+ *
+ * If no error occurs, the reference count of the original object is
+ * incremented if the object has not been duplicated, and nothing is done
+ * to a reference count of the duplicate. Now the reference count of an
+ * unduplicated object is 2 (the returned pointer, plus the one stored in
+ * the variable). The reference count of a duplicate object is 1,
+ * reflecting that the returned pointer is the only active reference. The
+ * caller is expected to store the returned value back in the variable
+ * and decrement its reference count. (INST_STORE_* does exactly this.)
+ *
+ * Surgery is performed on the unshared list value to produce the result.
+ * TclLsetFlat maintains a linked list of Tcl_Obj's whose string
* representations must be spoilt by threading via 'ptr2' of the
- * two-pointer internal representation. On entry to 'TclLsetFlat', the
+ * two-pointer internal representation. On entry to TclLsetFlat, the
* values of 'ptr2' are immaterial; on exit, the 'ptr2' field of any
* Tcl_Obj that has been modified is set to NULL.
*
@@ -1572,38 +1601,26 @@ TclLsetFlat(
*
* TclListObjSetElement --
*
- * Set a single element of a list to a specified value.
- *
- * It is the caller's responsibility to invalidate the string
- * representation of the 'listPtr'.
- *
- * Value
- *
- * TCL_OK
- *
- * Success.
- *
- * TCL_ERROR
- *
- * 'listPtr' does not refer to a list object and cannot be converted
- * to one. An error message will be left in the interpreter result if
- * interp is not NULL.
+ * Set a single element of a list to a specified value
*
- * TCL_ERROR
+ * Results:
+ * The return value is normally TCL_OK. If listPtr does not refer to a
+ * list object and cannot be converted to one, TCL_ERROR is returned and
+ * an error message will be left in the interpreter result if interp is
+ * not NULL. Similarly, if index designates an element outside the range
+ * [0..listLength-1], where listLength is the count of elements in the
+ * list object designated by listPtr, TCL_ERROR is returned and an error
+ * message is left in the interpreter result.
*
- * An index designates an element outside the range [0..listLength-1],
- * where 'listLength' is the count of elements in the list object
- * designated by 'listPtr'. An error message is left in the
- * interpreter result.
- *
- * Effect
- *
- * If 'listPtr' designates a shared object, 'Tcl_Panic' is called. If
- * 'listPtr' is not already of type 'tclListType', it is converted and the
- * internal representation is unshared. The 'refCount' of the element at
- * 'index' is decremented and replaced in the list with the 'valuePtr',
- * whose 'refCount' in turn is incremented.
+ * Side effects:
+ * Tcl_Panic if listPtr designates a shared object. Otherwise, attempts
+ * to convert it to a list with a non-shared internal rep. Decrements the
+ * ref count of the object at the specified index within the list,
+ * replaces with the object designated by valuePtr, and increments the
+ * ref count of the replacement object.
*
+ * It is the caller's responsibility to invalidate the string
+ * representation of the object.
*
*----------------------------------------------------------------------
*/
@@ -1721,14 +1738,16 @@ TclListObjSetElement(
*
* FreeListInternalRep --
*
- * Deallocate the storage associated with the internal representation of a
- * a list object.
+ * Deallocate the storage associated with a list object's internal
+ * representation.
*
- * Effect
+ * Results:
+ * None.
*
- * The storage for the internal 'List' pointer of 'listPtr' is freed, the
- * 'internalRep.twoPtrValue.ptr1' of 'listPtr' is set to NULL, and the 'refCount'
- * of each element of the list is decremented.
+ * Side effects:
+ * Frees listPtr's List* internal representation and sets listPtr's
+ * internalRep.twoPtrValue.ptr1 to NULL. Decrements the ref counts of all
+ * element objects, which may free them.
*
*----------------------------------------------------------------------
*/
@@ -1757,12 +1776,14 @@ FreeListInternalRep(
*
* DupListInternalRep --
*
- * Initialize the internal representation of a list 'Tcl_Obj' to share the
+ * Initialize the internal representation of a list Tcl_Obj to share the
* internal representation of an existing list object.
*
- * Effect
+ * Results:
+ * None.
*
- * The 'refCount' of the List internal rep is incremented.
+ * Side effects:
+ * The reference count of the List internal rep is incremented.
*
*----------------------------------------------------------------------
*/
@@ -1782,20 +1803,16 @@ DupListInternalRep(
*
* SetListFromAny --
*
- * Convert any object to a list.
- *
- * Value
+ * Attempt to generate a list internal form for the Tcl object "objPtr".
*
- * TCL_OK
- *
- * Success. The internal representation of 'objPtr' is set, and the type
- * of 'objPtr' is 'tclListType'.
- *
- * TCL_ERROR
- *
- * An error occured during conversion. An error message is left in the
- * interpreter's result if 'interp' is not NULL.
+ * Results:
+ * The return value is TCL_OK or TCL_ERROR. If an error occurs during
+ * conversion, an error message is left in the interpreter's result
+ * unless "interp" is NULL.
*
+ * Side effects:
+ * If no error occurs, a list is stored as "objPtr"s internal
+ * representation.
*
*----------------------------------------------------------------------
*/
@@ -1920,16 +1937,18 @@ SetListFromAny(
*
* UpdateStringOfList --
*
- * Update the string representation for a list object.
- *
- * Any previously-exising string representation is not invalidated, so
- * storage is lost if this has not been taken care of.
+ * Update the string representation for a list object. Note: This
+ * function does not invalidate an existing old string rep so storage
+ * will be lost if this has not already been done.
*
- * Effect
+ * Results:
+ * None.
*
- * The string representation of 'listPtr' is set to the resulting string.
- * This string will be empty if the list has no elements. It is assumed
- * that the list internal representation is not NULL.
+ * Side effects:
+ * The object's string is set to a valid string that results from the
+ * list-to-string conversion. This string will be empty if the list has
+ * no elements. The list internal representation should not be NULL and
+ * we assume it is not NULL.
*
*----------------------------------------------------------------------
*/
diff --git a/generic/tclLoad.c b/generic/tclLoad.c
index 4e6ee2f..e0bb5ef 100644
--- a/generic/tclLoad.c
+++ b/generic/tclLoad.c
@@ -470,17 +470,6 @@ Tcl_LoadObjCmd(
*/
if (code != TCL_OK) {
- Interp *iPtr = (Interp *) target;
- if (iPtr->legacyResult && !iPtr->legacyFreeProc) {
- /*
- * A call to Tcl_InitStubs() determined the caller extension and
- * this interp are incompatible in their stubs mechanisms, and
- * recorded the error in the oldest legacy place we have to do so.
- */
- Tcl_SetObjResult(target, Tcl_NewStringObj(iPtr->legacyResult, -1));
- iPtr->legacyResult = NULL;
- iPtr->legacyFreeProc = (void (*) (void))-1;
- }
Tcl_TransferResult(target, code, interp);
goto done;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 5e194c7..634f8db 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -2434,26 +2434,23 @@ Tcl_SetIntObj(
*
* Tcl_GetIntFromObj --
*
- * Retrieve the integer value of 'objPtr'.
+ * Attempt to return an int from the Tcl object "objPtr". If the object
+ * is not already an int, an attempt will be made to convert it to one.
*
- * Value
- *
- * TCL_OK
- *
- * Success.
- *
- * TCL_ERROR
- *
- * An error occurred during conversion or the integral value can not
- * be represented as an integer (it might be too large). An error
- * message is left in the interpreter's result if 'interp' is not
- * NULL.
+ * Integer and long integer objects share the same "integer" type
+ * implementation. We store all integers as longs and Tcl_GetIntFromObj
+ * checks whether the current value of the long can be represented by an
+ * int.
*
- * Effect
+ * Results:
+ * The return value is a standard Tcl object result. If an error occurs
+ * during conversion or if the long integer held by the object can not be
+ * represented by an int, an error message is left in the interpreter's
+ * result unless "interp" is NULL.
*
- * 'objPtr' is converted to an integer if necessary if it is not one
- * already. The conversion frees any previously-existing internal
- * representation.
+ * Side effects:
+ * If the object is not already an int, the conversion will free any old
+ * internal representation.
*
*----------------------------------------------------------------------
*/
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 5a8ef61..57a6de5 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -27,6 +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
@@ -244,9 +247,47 @@ Tcl_SaveResult(
* reference. Put an empty object into the interpreter.
*/
- *statePtr = iPtr->objResultPtr;
+ statePtr->objResultPtr = iPtr->objResultPtr;
iPtr->objResultPtr = Tcl_NewObj();
Tcl_IncrRefCount(iPtr->objResultPtr);
+
+ /*
+ * Save the string result.
+ */
+
+ statePtr->freeProc = iPtr->freeProc;
+ if (iPtr->result == iPtr->resultSpace) {
+ /*
+ * Copy the static string data out of the interp buffer.
+ */
+
+ statePtr->result = statePtr->resultSpace;
+ strcpy(statePtr->result, iPtr->result);
+ statePtr->appendResult = NULL;
+ } else if (iPtr->result == iPtr->appendResult) {
+ /*
+ * Move the append buffer out of the interp.
+ */
+
+ statePtr->appendResult = iPtr->appendResult;
+ statePtr->appendAvl = iPtr->appendAvl;
+ statePtr->appendUsed = iPtr->appendUsed;
+ statePtr->result = statePtr->appendResult;
+ iPtr->appendResult = NULL;
+ iPtr->appendAvl = 0;
+ iPtr->appendUsed = 0;
+ } else {
+ /*
+ * Move the dynamic or static string out of the interpreter.
+ */
+
+ statePtr->result = iPtr->result;
+ statePtr->appendResult = NULL;
+ }
+
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+ iPtr->freeProc = 0;
}
/*
@@ -278,11 +319,44 @@ Tcl_RestoreResult(
Tcl_ResetResult(interp);
/*
+ * Restore the string result.
+ */
+
+ iPtr->freeProc = statePtr->freeProc;
+ if (statePtr->result == statePtr->resultSpace) {
+ /*
+ * Copy the static string data into the interp buffer.
+ */
+
+ iPtr->result = iPtr->resultSpace;
+ strcpy(iPtr->result, statePtr->result);
+ } else if (statePtr->result == statePtr->appendResult) {
+ /*
+ * Move the append buffer back into the interp.
+ */
+
+ if (iPtr->appendResult != NULL) {
+ ckfree(iPtr->appendResult);
+ }
+
+ iPtr->appendResult = statePtr->appendResult;
+ iPtr->appendAvl = statePtr->appendAvl;
+ iPtr->appendUsed = statePtr->appendUsed;
+ iPtr->result = iPtr->appendResult;
+ } else {
+ /*
+ * Move the dynamic or static string back into the interpreter.
+ */
+
+ iPtr->result = statePtr->result;
+ }
+
+ /*
* Restore the object result.
*/
Tcl_DecrRefCount(iPtr->objResultPtr);
- iPtr->objResultPtr = *statePtr;
+ iPtr->objResultPtr = statePtr->objResultPtr;
}
/*
@@ -308,7 +382,15 @@ void
Tcl_DiscardResult(
Tcl_SavedResult *statePtr) /* State returned by Tcl_SaveResult. */
{
- Tcl_DecrRefCount(*statePtr);
+ TclDecrRefCount(statePtr->objResultPtr);
+
+ if (statePtr->result == statePtr->appendResult) {
+ ckfree(statePtr->appendResult);
+ } else if (statePtr->freeProc == TCL_DYNAMIC) {
+ ckfree(statePtr->result);
+ } else if (statePtr->freeProc) {
+ statePtr->freeProc(statePtr->result);
+ }
}
/*
@@ -338,15 +420,49 @@ Tcl_SetResult(
* TCL_STATIC, TCL_VOLATILE, or the address of
* a Tcl_FreeProc such as free. */
{
- Tcl_SetObjResult(interp, Tcl_NewStringObj(result, -1));
- if (result == NULL || freeProc == NULL || freeProc == TCL_VOLATILE) {
- return;
- }
- if (freeProc == TCL_DYNAMIC) {
- ckfree(result);
+ Interp *iPtr = (Interp *) interp;
+ register Tcl_FreeProc *oldFreeProc = iPtr->freeProc;
+ char *oldResult = iPtr->result;
+
+ if (result == NULL) {
+ iPtr->resultSpace[0] = 0;
+ iPtr->result = iPtr->resultSpace;
+ iPtr->freeProc = 0;
+ } else if (freeProc == TCL_VOLATILE) {
+ int length = strlen(result);
+
+ if (length > TCL_RESULT_SIZE) {
+ iPtr->result = ckalloc(length + 1);
+ iPtr->freeProc = TCL_DYNAMIC;
+ } else {
+ iPtr->result = iPtr->resultSpace;
+ iPtr->freeProc = 0;
+ }
+ memcpy(iPtr->result, result, (unsigned) length+1);
} else {
- (*freeProc)(result);
+ iPtr->result = (char *) result;
+ iPtr->freeProc = freeProc;
+ }
+
+ /*
+ * If the old result was dynamically-allocated, free it up. Do it here,
+ * rather than at the beginning, in case the new result value was part of
+ * the old result value.
+ */
+
+ if (oldFreeProc != 0) {
+ if (oldFreeProc == TCL_DYNAMIC) {
+ ckfree(oldResult);
+ } else {
+ oldFreeProc(oldResult);
+ }
}
+
+ /*
+ * Reset the object result since we just set the string result.
+ */
+
+ ResetObjResult(iPtr);
}
#endif /* !TCL_NO_DEPRECATED */
@@ -372,8 +488,20 @@ 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.
+ */
+
+ if (*(iPtr->result) == 0) {
+ Tcl_SetResult(interp, TclGetString(Tcl_GetObjResult(interp)),
+ TCL_VOLATILE);
+ }
+ return iPtr->result;
+#endif
}
/*
@@ -414,6 +542,23 @@ Tcl_SetObjResult(
*/
TclDecrRefCount(oldObjResult);
+
+#ifndef TCL_NO_DEPRECATED
+ /*
+ * Reset the string result since we just set the result object.
+ */
+
+ if (iPtr->freeProc != NULL) {
+ if (iPtr->freeProc == TCL_DYNAMIC) {
+ ckfree(iPtr->result);
+ } else {
+ iPtr->freeProc(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+#endif
}
/*
@@ -442,7 +587,34 @@ Tcl_GetObjResult(
Tcl_Interp *interp) /* Interpreter whose result to return. */
{
register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
+ Tcl_Obj *objResultPtr;
+ int length;
+ /*
+ * If the string result is non-empty, move the string result to the object
+ * result, then reset the string result.
+ */
+
+ if (iPtr->result[0] != 0) {
+ ResetObjResult(iPtr);
+
+ objResultPtr = iPtr->objResultPtr;
+ length = strlen(iPtr->result);
+ TclInitStringRep(objResultPtr, iPtr->result, length);
+
+ if (iPtr->freeProc != NULL) {
+ if (iPtr->freeProc == TCL_DYNAMIC) {
+ ckfree(iPtr->result);
+ } else {
+ iPtr->freeProc(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+ iPtr->result = iPtr->resultSpace;
+ iPtr->result[0] = 0;
+ }
+#endif /* !TCL_NO_DEPRECATED */
return iPtr->objResultPtr;
}
@@ -479,6 +651,23 @@ Tcl_AppendResultVA(
}
Tcl_AppendStringsToObjVA(objPtr, argList);
Tcl_SetObjResult(interp, objPtr);
+
+ /*
+ * Strictly we should call Tcl_GetStringResult(interp) here to make sure
+ * that interp->result is correct according to the old contract, but that
+ * makes the performance of much code (e.g. in Tk) absolutely awful. So we
+ * leave it out; code that really wants interp->result can just insert the
+ * calls to Tcl_GetStringResult() itself. [Patch 1041072 discussion]
+ */
+
+#ifdef USE_INTERP_RESULT
+ /*
+ * Ensure that the interp->result is legal so old Tcl 7.* code still
+ * works. There's still embarrasingly much of it about...
+ */
+
+ (void) Tcl_GetStringResult(interp);
+#endif /* USE_INTERP_RESULT */
}
/*
@@ -544,6 +733,7 @@ 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;
@@ -557,7 +747,134 @@ Tcl_AppendElement(
}
Tcl_AppendObjToObj(iPtr->objResultPtr, listPtr);
Tcl_DecrRefCount(listPtr);
+#else
+ char *dst;
+ int size;
+ int flags;
+
+ /*
+ * If the string result is empty, move the object result to the string
+ * result, then reset the object result.
+ */
+
+ (void) Tcl_GetStringResult(interp);
+
+ /*
+ * See how much space is needed, and grow the append buffer if needed to
+ * accommodate the list element.
+ */
+
+ size = Tcl_ScanElement(element, &flags) + 1;
+ if ((iPtr->result != iPtr->appendResult)
+ || (iPtr->appendResult[iPtr->appendUsed] != 0)
+ || ((size + iPtr->appendUsed) >= iPtr->appendAvl)) {
+ SetupAppendBuffer(iPtr, size+iPtr->appendUsed);
+ }
+
+ /*
+ * Convert the string into a list element and copy it to the buffer that's
+ * forming, with a space separator if needed.
+ */
+
+ dst = iPtr->appendResult + iPtr->appendUsed;
+ if (TclNeedSpace(iPtr->appendResult, dst)) {
+ iPtr->appendUsed++;
+ *dst = ' ';
+ dst++;
+
+ /*
+ * If we need a space to separate this element from preceding stuff,
+ * then this element will not lead a list, and need not have it's
+ * leading '#' quoted.
+ */
+
+ flags |= TCL_DONT_QUOTE_HASH;
+ }
+ iPtr->appendUsed += Tcl_ConvertElement(element, dst, flags);
+#endif /* !TCL_NO_DEPRECATED */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupAppendBuffer --
+ *
+ * This function makes sure that there is an append buffer properly
+ * initialized, if necessary, from the interpreter's result, and that it
+ * has at least enough room to accommodate newSpace new bytes of
+ * information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_NO_DEPRECATED
+static void
+SetupAppendBuffer(
+ Interp *iPtr, /* Interpreter whose result is being set up. */
+ int newSpace) /* Make sure that at least this many bytes of
+ * new information may be added. */
+{
+ int totalSpace;
+
+ /*
+ * Make the append buffer larger, if that's necessary, then copy the
+ * result into the append buffer and make the append buffer the official
+ * Tcl result.
+ */
+
+ if (iPtr->result != iPtr->appendResult) {
+ /*
+ * If an oversized buffer was used recently, then free it up so we go
+ * back to a smaller buffer. This avoids tying up memory forever after
+ * a large operation.
+ */
+
+ if (iPtr->appendAvl > 500) {
+ ckfree(iPtr->appendResult);
+ iPtr->appendResult = NULL;
+ iPtr->appendAvl = 0;
+ }
+ iPtr->appendUsed = strlen(iPtr->result);
+ } else if (iPtr->result[iPtr->appendUsed] != 0) {
+ /*
+ * Most likely someone has modified a result created by
+ * Tcl_AppendResult et al. so that it has a different size. Just
+ * recompute the size.
+ */
+
+ iPtr->appendUsed = strlen(iPtr->result);
+ }
+
+ totalSpace = newSpace + iPtr->appendUsed;
+ if (totalSpace >= iPtr->appendAvl) {
+ char *new;
+
+ if (totalSpace < 100) {
+ totalSpace = 200;
+ } else {
+ totalSpace *= 2;
+ }
+ new = ckalloc(totalSpace);
+ strcpy(new, iPtr->result);
+ if (iPtr->appendResult != NULL) {
+ ckfree(iPtr->appendResult);
+ }
+ iPtr->appendResult = new;
+ iPtr->appendAvl = totalSpace;
+ } else if (iPtr->result != iPtr->appendResult) {
+ strcpy(iPtr->appendResult, iPtr->result);
+ }
+
+ Tcl_FreeResult((Tcl_Interp *) iPtr);
+ iPtr->result = iPtr->appendResult;
}
+#endif /* !TCL_NO_DEPRECATED */
/*
*----------------------------------------------------------------------
@@ -565,17 +882,18 @@ Tcl_AppendElement(
* Tcl_FreeResult --
*
* This function frees up the memory associated with an interpreter's
- * result, resetting the interpreter's result object. Tcl_FreeResult is
- * most commonly used when a function is about to replace one result
- * value with another.
+ * string result. It also resets the interpreter's result object.
+ * Tcl_FreeResult is most commonly used when a function is about to
+ * replace one result value with another.
*
* Results:
* None.
*
* Side effects:
- * Frees the memory associated with interp's result but does not change
- * any part of the error dictionary (i.e., the errorinfo and errorcode
- * remain the same).
+ * Frees the memory associated with interp's string result and sets
+ * interp->freeProc to zero, but does not change interp->result or clear
+ * error state. Resets interp's result object to an unshared empty
+ * object.
*
*----------------------------------------------------------------------
*/
@@ -586,6 +904,17 @@ Tcl_FreeResult(
{
register Interp *iPtr = (Interp *) interp;
+#ifndef TCL_NO_DEPRECATED
+ if (iPtr->freeProc != NULL) {
+ if (iPtr->freeProc == TCL_DYNAMIC) {
+ ckfree(iPtr->result);
+ } else {
+ iPtr->freeProc(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+
+#endif /* !TCL_NO_DEPRECATED */
ResetObjResult(iPtr);
}
@@ -615,6 +944,18 @@ 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);
+ } else {
+ iPtr->freeProc(iPtr->result);
+ }
+ iPtr->freeProc = 0;
+ }
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
if (iPtr->errorCode) {
/* Legacy support */
if (iPtr->flags & ERR_LEGACY_COPY) {
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index d36415c..ac2ca68 100755..100644
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -483,7 +483,7 @@ TclParseNumber(
enum State {
INITIAL, SIGNUM, ZERO, ZERO_X,
ZERO_O, ZERO_B, ZERO_D, BINARY,
- HEXADECIMAL, OCTAL, DECIMAL,
+ HEXADECIMAL, OCTAL, BAD_OCTAL, DECIMAL,
LEADING_RADIX_POINT, FRACTION,
EXPONENT_START, EXPONENT_SIGNUM, EXPONENT,
sI, sIN, sINF, sINFI, sINFIN, sINFINI, sINFINIT, sINFINITY
@@ -528,6 +528,7 @@ TclParseNumber(
char d = 0; /* Last hexadecimal digit scanned; initialized
* to avoid a compiler warning. */
int shift = 0; /* Amount to shift when accumulating binary */
+ int explicitOctal = 0;
#define ALL_BITS (~(Tcl_WideUInt)0)
#define MOST_BITS (ALL_BITS >> 1)
@@ -659,6 +660,7 @@ TclParseNumber(
goto zerob;
}
if (c == 'o' || c == 'O') {
+ explicitOctal = 1;
state = ZERO_O;
break;
}
@@ -666,7 +668,10 @@ TclParseNumber(
state = ZERO_D;
break;
}
+#ifdef TCL_NO_DEPRECATED
goto decimal;
+#endif
+ /* FALLTHROUGH */
case OCTAL:
/*
@@ -729,6 +734,58 @@ TclParseNumber(
state = OCTAL;
break;
}
+ /* FALLTHROUGH */
+
+ case BAD_OCTAL:
+ if (explicitOctal) {
+ /*
+ * No forgiveness for bad digits in explicitly octal numbers.
+ */
+
+ goto endgame;
+ }
+ if (flags & TCL_PARSE_INTEGER_ONLY) {
+ /*
+ * No seeking floating point when parsing only integer.
+ */
+
+ goto endgame;
+ }
+#ifndef TCL_NO_DEPRECATED
+
+ /*
+ * Scanned a number with a leading zero that contains an 8, 9,
+ * radix point or E. This is an invalid octal number, but might
+ * still be floating point.
+ */
+
+ if (c == '0') {
+ numTrailZeros++;
+ state = BAD_OCTAL;
+ break;
+ } else if (isdigit(UCHAR(c))) {
+ if (objPtr != NULL) {
+ significandOverflow = AccumulateDecimalDigit(
+ (unsigned)(c-'0'), numTrailZeros,
+ &significandWide, &significandBig,
+ significandOverflow);
+ }
+ if (numSigDigs != 0) {
+ numSigDigs += (numTrailZeros + 1);
+ } else {
+ numSigDigs = 1;
+ }
+ numTrailZeros = 0;
+ state = BAD_OCTAL;
+ break;
+ } else if (c == '.') {
+ state = FRACTION;
+ break;
+ } else if (c == 'E' || c == 'e') {
+ state = EXPONENT_START;
+ break;
+ }
+#endif
goto endgame;
/*
@@ -843,7 +900,9 @@ TclParseNumber(
* digits.
*/
+#ifdef TCL_NO_DEPRECATED
decimal:
+#endif
acceptState = state;
acceptPoint = p;
acceptLen = len;
@@ -1127,6 +1186,7 @@ TclParseNumber(
TclFreeIntRep(objPtr);
switch (acceptState) {
case SIGNUM:
+ case BAD_OCTAL:
case ZERO_X:
case ZERO_O:
case ZERO_B:
@@ -1324,6 +1384,9 @@ TclParseNumber(
Tcl_AppendLimitedToObj(msg, bytes, numBytes, 50, "");
Tcl_AppendToObj(msg, "\"", -1);
+ if (state == BAD_OCTAL) {
+ Tcl_AppendToObj(msg, " (looks like invalid octal number)", -1);
+ }
Tcl_SetObjResult(interp, msg);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "NUMBER", NULL);
}
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index b26fb01..5261591 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -66,8 +66,8 @@ Tcl_InitStubs(
*/
if (!stubsPtr || (stubsPtr->magic != (((exact&0xff00) >= 0x900) ? magic : TCL_STUB_MAGIC))) {
- iPtr->legacyResult = "interpreter uses an incompatible stubs mechanism";
- iPtr->legacyFreeProc = 0; /* TCL_STATIC */
+ iPtr->result = (char *)"interpreter uses an incompatible stubs mechanism";
+ iPtr->freeProc = 0;
return NULL;
}
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 46e07fa..834cd79 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -5228,6 +5228,7 @@ TestsaveresultCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* The argument objects. */
{
+ Interp* iPtr = (Interp*) interp;
int discard, result, index;
Tcl_SavedResult state;
Tcl_Obj *objPtr;
@@ -5295,9 +5296,12 @@ TestsaveresultCmd(
}
switch ((enum options) index) {
- case RESULT_DYNAMIC:
- Tcl_AppendElement(interp, freeCount ? "freed" : "leak");
+ case RESULT_DYNAMIC: {
+ int presentOrFreed = (iPtr->freeProc == TestsaveresultFree) ^ freeCount;
+
+ Tcl_AppendElement(interp, presentOrFreed ? "presentOrFreed" : "missingOrLeak");
break;
+ }
case RESULT_OBJECT:
Tcl_AppendElement(interp, Tcl_GetObjResult(interp) == objPtr
? "same" : "different");
diff --git a/generic/tclUtil.c b/generic/tclUtil.c
index bdea37f..61a84ce 100644
--- a/generic/tclUtil.c
+++ b/generic/tclUtil.c
@@ -2923,12 +2923,86 @@ Tcl_DStringGetResult(
Tcl_DString *dsPtr) /* Dynamic string that is to become the result
* of interp. */
{
- int length;
- char *bytes = TclGetStringFromObj(Tcl_GetObjResult(interp), &length);
+#ifdef TCL_NO_DEPRECATED
+ Tcl_Obj *obj = Tcl_GetObjResult(interp);
+ const char *bytes = TclGetString(obj);
Tcl_DStringFree(dsPtr);
- Tcl_DStringAppend(dsPtr, bytes, length);
+ Tcl_DStringAppend(dsPtr, bytes, obj->length);
Tcl_ResetResult(interp);
+#else
+ Interp *iPtr = (Interp *) interp;
+
+ if (dsPtr->string != dsPtr->staticSpace) {
+ ckfree(dsPtr->string);
+ }
+
+ /*
+ * Do more efficient transfer when we know the result is a Tcl_Obj. When
+ * 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.
+
+ * 2. When the string rep is not there or there's a real string rep, when
+ * we use Tcl_GetString to fetch (or generate) the string rep - which
+ * we know to have been allocated with ckalloc() - and use it to
+ * populate the DString space. Then, we free the internal rep. and set
+ * the object's string representation back to the canonical empty
+ * string.
+ */
+
+ if (!iPtr->result[0] && iPtr->objResultPtr
+ && !Tcl_IsShared(iPtr->objResultPtr)) {
+ if (iPtr->objResultPtr->bytes == &tclEmptyString) {
+ dsPtr->string = dsPtr->staticSpace;
+ dsPtr->string[0] = 0;
+ dsPtr->length = 0;
+ dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+ } else {
+ dsPtr->string = TclGetString(iPtr->objResultPtr);
+ dsPtr->length = iPtr->objResultPtr->length;
+ dsPtr->spaceAvl = dsPtr->length + 1;
+ TclFreeIntRep(iPtr->objResultPtr);
+ iPtr->objResultPtr->bytes = &tclEmptyString;
+ iPtr->objResultPtr->length = 0;
+ }
+ return;
+ }
+
+ /*
+ * If the string result is empty, move the object result to the string
+ * result, then reset the object result.
+ */
+
+ (void) Tcl_GetStringResult(interp);
+
+ dsPtr->length = strlen(iPtr->result);
+ if (iPtr->freeProc != NULL) {
+ if (iPtr->freeProc == TCL_DYNAMIC) {
+ dsPtr->string = iPtr->result;
+ dsPtr->spaceAvl = dsPtr->length+1;
+ } else {
+ dsPtr->string = ckalloc(dsPtr->length+1);
+ memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
+ iPtr->freeProc(iPtr->result);
+ }
+ dsPtr->spaceAvl = dsPtr->length+1;
+ iPtr->freeProc = NULL;
+ } else {
+ if (dsPtr->length < TCL_DSTRING_STATIC_SIZE) {
+ dsPtr->string = dsPtr->staticSpace;
+ dsPtr->spaceAvl = TCL_DSTRING_STATIC_SIZE;
+ } else {
+ dsPtr->string = ckalloc(dsPtr->length+1);
+ dsPtr->spaceAvl = dsPtr->length + 1;
+ }
+ memcpy(dsPtr->string, iPtr->result, (unsigned) dsPtr->length+1);
+ }
+
+ iPtr->result = iPtr->resultSpace;
+ iPtr->resultSpace[0] = 0;
+#endif /* !TCL_NO_DEPRECATED */
}
/*
@@ -3479,27 +3553,22 @@ TclFormatInt(
*
* TclGetIntForIndex --
*
- * Provides an integer corresponding to the list index held in a Tcl
- * object. The string value 'objPtr' is expected have the format
- * integer([+-]integer)? or end([+-]integer)?.
- *
- * Value
- * TCL_OK
- *
- * The index is stored at the address given by by 'indexPtr'. If
- * 'objPtr' has the value "end", the value stored is 'endValue'.
- *
- * TCL_ERROR
- *
- * The value of 'objPtr' does not have one of the expected formats. If
- * 'interp' is non-NULL, an error message is left in the interpreter's
- * result object.
- *
- * Effect
- *
- * The object referenced by 'objPtr' is converted, as needed, to an
- * integer, wide integer, or end-based-index object.
- *
+ * This function returns an integer corresponding to the list index held
+ * in a Tcl object. The Tcl object's value is expected to be in the
+ * format integer([+-]integer)? or the format end([+-]integer)?.
+ *
+ * Results:
+ * The return value is normally TCL_OK, which means that the index was
+ * successfully stored into the location referenced by "indexPtr". If the
+ * Tcl object referenced by "objPtr" has the value "end", the value
+ * stored is "endValue". If "objPtr"s values is not of one of the
+ * expected formats, TCL_ERROR is returned and, if "interp" is non-NULL,
+ * an error message is left in the interpreter's result object.
+ *
+ * Side effects:
+ * The object referenced by "objPtr" might be converted to an integer,
+ * wide integer, or end-based-index object.
+ *
*----------------------------------------------------------------------
*/
@@ -3586,6 +3655,7 @@ TclGetIntForIndex(
if (!strncmp(bytes, "end-", 4)) {
bytes += 4;
}
+ TclCheckBadOctal(interp, bytes);
Tcl_SetErrorCode(interp, "TCL", "VALUE", "INDEX", NULL);
}
@@ -3734,6 +3804,73 @@ SetEndOffsetFromAny(
/*
*----------------------------------------------------------------------
*
+ * TclCheckBadOctal --
+ *
+ * This function checks for a bad octal value and appends a meaningful
+ * error to the interp's result.
+ *
+ * Results:
+ * 1 if the argument was a bad octal, else 0.
+ *
+ * Side effects:
+ * The interpreter's result is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCheckBadOctal(
+ Tcl_Interp *interp, /* Interpreter to use for error reporting. If
+ * NULL, then no error message is left after
+ * errors. */
+ const char *value) /* String to check. */
+{
+ register const char *p = value;
+
+ /*
+ * A frequent mistake is invalid octal values due to an unwanted leading
+ * zero. Try to generate a meaningful error message.
+ */
+
+ while (TclIsSpaceProc(*p)) {
+ p++;
+ }
+ if (*p == '+' || *p == '-') {
+ p++;
+ }
+ if (*p == '0') {
+ if ((p[1] == 'o') || p[1] == 'O') {
+ p += 2;
+ }
+ while (isdigit(UCHAR(*p))) { /* INTL: digit. */
+ p++;
+ }
+ while (TclIsSpaceProc(*p)) {
+ p++;
+ }
+ if (*p == '\0') {
+ /*
+ * Reached end of string.
+ */
+
+ if (interp != NULL) {
+ /*
+ * Don't reset the result here because we want this result to
+ * be added to an existing error message as extra info.
+ */
+
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ " (looks like invalid octal number)", -1);
+ }
+ return 1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* ClearHash --
*
* Remove all the entries in the hash table *tablePtr.
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 4f2d435..7c8bb73 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -816,8 +816,12 @@ TclLookupSimpleVar(
*indexPtr = -1;
flags = (flags | TCL_GLOBAL_ONLY) & ~TCL_NAMESPACE_ONLY;
} else {
- flags = (flags | TCL_NAMESPACE_ONLY);
- *indexPtr = -2;
+ if (flags & TCL_AVOID_RESOLVERS) {
+ flags = (flags | TCL_NAMESPACE_ONLY);
+ }
+ if (flags & TCL_NAMESPACE_ONLY) {
+ *indexPtr = -2;
+ }
}
/*
@@ -5705,10 +5709,6 @@ ObjFindNamespaceVar(
* Find the namespace(s) that contain the variable.
*/
- if (!(flags & TCL_GLOBAL_ONLY)) {
- flags |= TCL_NAMESPACE_ONLY;
- }
-
TclGetNamespaceForQualName(interp, name, (Namespace *) contextNsPtr,
flags, &nsPtr[0], &nsPtr[1], &cxtNsPtr, &simpleName);
diff --git a/library/init.tcl b/library/init.tcl
index 4ef78a5..87d9f14 100644
--- a/library/init.tcl
+++ b/library/init.tcl
@@ -16,7 +16,7 @@
if {[info commands package] == ""} {
error "version mismatch: library\nscripts expect Tcl version 7.5b1 or later but the loaded version is\nonly [info patchlevel]"
}
-package require -exact Tcl 9.0a0
+package require -exact Tcl 8.7a2
# Compute the auto path to use in this interpreter.
# The values on the path come from several locations:
diff --git a/library/safe.tcl b/library/safe.tcl
index c48d002..ea6391d 100644
--- a/library/safe.tcl
+++ b/library/safe.tcl
@@ -113,7 +113,7 @@ proc ::safe::CheckInterp {slave} {
# we had the bad idea to support for the sake of user simplicity in
# create/init but which makes life hard in configure...
# So this will be hopefully written and some integrated with opt1.0
-# (hopefully for tcl9.0 ?)
+# (hopefully for tcl8.1 ?)
proc ::safe::interpConfigure {args} {
switch [llength $args] {
1 {
diff --git a/macosx/README b/macosx/README
index 02611fd..551a18e 100644
--- a/macosx/README
+++ b/macosx/README
@@ -113,7 +113,7 @@ The following build configurations are available:
The Xcode projects refer to the toplevel tcl source directory via the
TCL_SRCROOT user build setting, by default this is set to the project-relative
path '../../tcl', if your tcl source directory is named differently, e.g.
-'../../tcl9.0', you need to manually change the TCL_SRCROOT setting by editing
+'../../tcl8.7', you need to manually change the TCL_SRCROOT setting by editing
your ${USER}.pbxuser file (located inside the Tcl.xcodeproj bundle directory)
with a text editor.
@@ -141,9 +141,9 @@ Detailed Instructions for building with macosx/GNUmakefile
- Unpack the Tcl source release archive.
- The following instructions assume the Tcl source tree is named "tcl${ver}",
-(where ${ver} is a shell variable containing the Tcl version number e.g. '9.0').
+(where ${ver} is a shell variable containing the Tcl version number e.g. '8.7').
Setup this shell variable as follows:
- ver="9.0"
+ ver="8.7"
If you are building from CVS, omit this step (CVS source tree names usually do
not contain a version number).
diff --git a/macosx/Tcl-Common.xcconfig b/macosx/Tcl-Common.xcconfig
index 13b5df5..77402b7 100644
--- a/macosx/Tcl-Common.xcconfig
+++ b/macosx/Tcl-Common.xcconfig
@@ -34,4 +34,4 @@ TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
-VERSION = 9.0
+VERSION = 8.7
diff --git a/tests/assemble.test b/tests/assemble.test
index 004d04d..6e5308d 100644
--- a/tests/assemble.test
+++ b/tests/assemble.test
@@ -781,7 +781,7 @@ test assemble-7.43 {uplus} {
}
}
-returnCodes error
- -result {can't use non-numeric floating-point value "NaN" as operand of "+"}
+ -result {can't use non-numeric floating-point value as operand of "+"}
}
test assemble-7.43.1 {tryCvtToNumeric} {
-body {
diff --git a/tests/compExpr-old.test b/tests/compExpr-old.test
index 7144487..bae26a0 100644
--- a/tests/compExpr-old.test
+++ b/tests/compExpr-old.test
@@ -285,10 +285,10 @@ test compExpr-old-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of "^"}}
+} {1 {can't use floating-point value as operand of "^"}}
test compExpr-old-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "^"}}
+} {1 {can't use non-numeric string as operand of "^"}}
test compExpr-old-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test compExpr-old-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
@@ -309,10 +309,10 @@ test compExpr-old-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of "&"}}
+} {1 {can't use floating-point value as operand of "&"}}
test compExpr-old-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "&"}}
+} {1 {can't use non-numeric string as operand of "&"}}
test compExpr-old-8.1 {CompileEqualityExpr: just relational expr} {expr 3>=2} 1
test compExpr-old-8.2 {CompileEqualityExpr: just relational expr} {expr 2<=2.1} 1
@@ -377,10 +377,10 @@ test compExpr-old-10.9 {CompileShiftExpr: error compiling shift arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of ">>"}}
+} {1 {can't use floating-point value as operand of ">>"}}
test compExpr-old-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "<<"}}
+} {1 {can't use non-numeric string as operand of "<<"}}
test compExpr-old-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test compExpr-old-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
@@ -399,10 +399,10 @@ test compExpr-old-11.9 {CompileAddExpr: error compiling add arm} -body {
} -returnCodes error -match glob -result *
test compExpr-old-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test compExpr-old-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
test compExpr-old-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
@@ -430,10 +430,10 @@ test compExpr-old-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body
} -returnCodes error -match glob -result *
test compExpr-old-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "*"}}
+} {1 {can't use non-numeric string as operand of "*"}}
test compExpr-old-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "/"}}
+} {1 {can't use non-numeric string as operand of "/"}}
test compExpr-old-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test compExpr-old-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
@@ -451,10 +451,10 @@ test compExpr-old-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
} -returnCodes error -match glob -result *
test compExpr-old-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "~"}}
+} {1 {can't use non-numeric string as operand of "~"}}
test compExpr-old-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value "4.0" as operand of "~"}}
+} {1 {can't use floating-point value as operand of "~"}}
test compExpr-old-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test compExpr-old-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
diff --git a/tests/compile.test b/tests/compile.test
index c76bd82..2fa4147 100644
--- a/tests/compile.test
+++ b/tests/compile.test
@@ -323,7 +323,7 @@ test compile-11.2 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
} -returnCodes error -result {bad index "bogus": must be integer?[+-]integer? or end?[+-]integer?}
test compile-11.3 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; string index a 0o9 }}
-} -returnCodes error -match glob -result {*}
+} -returnCodes error -match glob -result {*invalid octal number*}
test compile-11.4 {Tcl_Append*: ensure Tcl_ResetResult is used properly} -body {
apply {{} { set r [list foobar] ; array set var {one two many} }}
} -returnCodes error -result {list must have an even number of elements}
diff --git a/tests/execute.test b/tests/execute.test
index 7bd2601..6c277f8 100644
--- a/tests/execute.test
+++ b/tests/execute.test
@@ -174,7 +174,7 @@ test execute-3.5 {TclExecuteByteCode, INST_ADD, op1 is string double} {testobj}
test execute-3.6 {TclExecuteByteCode, INST_ADD, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x + 1}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test execute-3.7 {TclExecuteByteCode, INST_ADD, op2 is int} {testobj} {
set x [testintobj set 0 1]
expr {1 + $x}
@@ -199,7 +199,7 @@ test execute-3.11 {TclExecuteByteCode, INST_ADD, op2 is string double} {testobj}
test execute-3.12 {TclExecuteByteCode, INST_ADD, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 + $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
# INST_SUB is partially tested:
test execute-3.13 {TclExecuteByteCode, INST_SUB, op1 is int} {testobj} {
@@ -226,7 +226,7 @@ test execute-3.17 {TclExecuteByteCode, INST_SUB, op1 is string double} {testobj}
test execute-3.18 {TclExecuteByteCode, INST_SUB, op1 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {$x - 1}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
test execute-3.19 {TclExecuteByteCode, INST_SUB, op2 is int} {testobj} {
set x [testintobj set 0 1]
expr {1 - $x}
@@ -251,7 +251,7 @@ test execute-3.23 {TclExecuteByteCode, INST_SUB, op2 is string double} {testobj}
test execute-3.24 {TclExecuteByteCode, INST_SUB, op2 is non-numeric} {testobj} {
set x [teststringobj set 0 foo]
list [catch {expr {1 - $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
# INST_MULT is partially tested:
test execute-3.25 {TclExecuteByteCode, INST_MULT, op1 is int} {testobj} {
@@ -278,7 +278,7 @@ test execute-3.29 {TclExecuteByteCode, INST_MULT, op1 is string double} {testobj
test execute-3.30 {TclExecuteByteCode, INST_MULT, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x * 1}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "*"}}
+} {1 {can't use non-numeric string as operand of "*"}}
test execute-3.31 {TclExecuteByteCode, INST_MULT, op2 is int} {testobj} {
set x [testintobj set 1 1]
expr {1 * $x}
@@ -303,7 +303,7 @@ test execute-3.35 {TclExecuteByteCode, INST_MULT, op2 is string double} {testobj
test execute-3.36 {TclExecuteByteCode, INST_MULT, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 * $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "*"}}
+} {1 {can't use non-numeric string as operand of "*"}}
# INST_DIV is partially tested:
test execute-3.37 {TclExecuteByteCode, INST_DIV, op1 is int} {testobj} {
@@ -330,7 +330,7 @@ test execute-3.41 {TclExecuteByteCode, INST_DIV, op1 is string double} {testobj}
test execute-3.42 {TclExecuteByteCode, INST_DIV, op1 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {$x / 1}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "/"}}
+} {1 {can't use non-numeric string as operand of "/"}}
test execute-3.43 {TclExecuteByteCode, INST_DIV, op2 is int} {testobj} {
set x [testintobj set 1 1]
expr {2 / $x}
@@ -355,7 +355,7 @@ test execute-3.47 {TclExecuteByteCode, INST_DIV, op2 is string double} {testobj}
test execute-3.48 {TclExecuteByteCode, INST_DIV, op2 is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {1 / $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "/"}}
+} {1 {can't use non-numeric string as operand of "/"}}
# INST_UPLUS is partially tested:
test execute-3.49 {TclExecuteByteCode, INST_UPLUS, op is int} {testobj} {
@@ -382,7 +382,7 @@ test execute-3.53 {TclExecuteByteCode, INST_UPLUS, op is string double} {testobj
test execute-3.54 {TclExecuteByteCode, INST_UPLUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {+ $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
# INST_UMINUS is partially tested:
test execute-3.55 {TclExecuteByteCode, INST_UMINUS, op is int} {testobj} {
@@ -409,7 +409,7 @@ test execute-3.59 {TclExecuteByteCode, INST_UMINUS, op is string double} {testob
test execute-3.60 {TclExecuteByteCode, INST_UMINUS, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {- $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
# INST_LNOT is partially tested:
test execute-3.61 {TclExecuteByteCode, INST_LNOT, op is int} {testobj} {
@@ -457,7 +457,7 @@ test execute-3.70 {TclExecuteByteCode, INST_LNOT, op is string double} {testobj}
test execute-3.71 {TclExecuteByteCode, INST_LNOT, op is non-numeric} {testobj} {
set x [teststringobj set 1 foo]
list [catch {expr {! $x}} msg] $msg
-} {1 {can't use non-numeric string "foo" as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
# INST_BITNOT not tested
# INST_CALL_BUILTIN_FUNC1 not tested
diff --git a/tests/expr-old.test b/tests/expr-old.test
index 54191b6..3adfb63 100644
--- a/tests/expr-old.test
+++ b/tests/expr-old.test
@@ -197,34 +197,34 @@ test expr-old-2.38 {floating-point operators} {
test expr-old-3.1 {illegal floating-point operations} {
list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value "4.0" as operand of "~"}}
+} {1 {can't use floating-point value as operand of "~"}}
test expr-old-3.2 {illegal floating-point operations} {
list [catch {expr 27%4.0} msg] $msg
-} {1 {can't use floating-point value "4.0" as operand of "%"}}
+} {1 {can't use floating-point value as operand of "%"}}
test expr-old-3.3 {illegal floating-point operations} {
list [catch {expr 27.0%4} msg] $msg
-} {1 {can't use floating-point value "27.0" as operand of "%"}}
+} {1 {can't use floating-point value as operand of "%"}}
test expr-old-3.4 {illegal floating-point operations} {
list [catch {expr 1.0<<3} msg] $msg
-} {1 {can't use floating-point value "1.0" as operand of "<<"}}
+} {1 {can't use floating-point value as operand of "<<"}}
test expr-old-3.5 {illegal floating-point operations} {
list [catch {expr 3<<1.0} msg] $msg
-} {1 {can't use floating-point value "1.0" as operand of "<<"}}
+} {1 {can't use floating-point value as operand of "<<"}}
test expr-old-3.6 {illegal floating-point operations} {
list [catch {expr 24.0>>3} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of ">>"}}
+} {1 {can't use floating-point value as operand of ">>"}}
test expr-old-3.7 {illegal floating-point operations} {
list [catch {expr 24>>3.0} msg] $msg
-} {1 {can't use floating-point value "3.0" as operand of ">>"}}
+} {1 {can't use floating-point value as operand of ">>"}}
test expr-old-3.8 {illegal floating-point operations} {
list [catch {expr 24&3.0} msg] $msg
-} {1 {can't use floating-point value "3.0" as operand of "&"}}
+} {1 {can't use floating-point value as operand of "&"}}
test expr-old-3.9 {illegal floating-point operations} {
list [catch {expr 24.0|3} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of "|"}}
+} {1 {can't use floating-point value as operand of "|"}}
test expr-old-3.10 {illegal floating-point operations} {
list [catch {expr 24.0^3} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of "^"}}
+} {1 {can't use floating-point value as operand of "^"}}
# Check the string operators individually.
@@ -265,46 +265,46 @@ test expr-old-4.32 {string operators} {expr {0?"foo":"bar"}} bar
test expr-old-5.1 {illegal string operations} {
list [catch {expr {-"a"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
test expr-old-5.2 {illegal string operations} {
list [catch {expr {+"a"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-5.3 {illegal string operations} {
list [catch {expr {~"a"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "~"}}
+} {1 {can't use non-numeric string as operand of "~"}}
test expr-old-5.4 {illegal string operations} {
list [catch {expr {!"a"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
test expr-old-5.5 {illegal string operations} {
list [catch {expr {"a"*"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "*"}}
+} {1 {can't use non-numeric string as operand of "*"}}
test expr-old-5.6 {illegal string operations} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "/"}}
+} {1 {can't use non-numeric string as operand of "/"}}
test expr-old-5.7 {illegal string operations} {
list [catch {expr {"a"%"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "%"}}
+} {1 {can't use non-numeric string as operand of "%"}}
test expr-old-5.8 {illegal string operations} {
list [catch {expr {"a"+"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-5.9 {illegal string operations} {
list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
test expr-old-5.10 {illegal string operations} {
list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "<<"}}
+} {1 {can't use non-numeric string as operand of "<<"}}
test expr-old-5.11 {illegal string operations} {
list [catch {expr {"a">>"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of ">>"}}
+} {1 {can't use non-numeric string as operand of ">>"}}
test expr-old-5.12 {illegal string operations} {
list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "&"}}
+} {1 {can't use non-numeric string as operand of "&"}}
test expr-old-5.13 {illegal string operations} {
list [catch {expr {"a"^"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "^"}}
+} {1 {can't use non-numeric string as operand of "^"}}
test expr-old-5.14 {illegal string operations} {
list [catch {expr {"a"|"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "|"}}
+} {1 {can't use non-numeric string as operand of "|"}}
test expr-old-5.15 {illegal string operations} {
list [catch {expr {"a"&&"b"}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -493,7 +493,7 @@ test expr-old-25.20 {type conversions} {expr 10.0} 10.0
test expr-old-26.1 {error conditions} {
list [catch {expr 2+"a"} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.2 {error conditions} -body {
expr 2+4*
} -returnCodes error -match glob -result *
@@ -507,10 +507,10 @@ test expr-old-26.4 {error conditions} {
set a xx
test expr-old-26.5 {error conditions} {
list [catch {expr {2+$a}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.6 {error conditions} {
list [catch {expr {2+[set a]}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-26.7 {error conditions} -body {
expr {2+(4}
} -returnCodes error -match glob -result *
@@ -534,7 +534,7 @@ test expr-old-26.12 {error conditions} -body {
} -returnCodes error -match glob -result *
test expr-old-26.13 {error conditions} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "/"}}
+} {1 {can't use non-numeric string as operand of "/"}}
test expr-old-26.14 {error conditions} -body {
expr 2:3
} -returnCodes error -match glob -result *
@@ -963,7 +963,7 @@ test expr-old-36.1 {ExprLooksLikeInt procedure} -body {
test expr-old-36.2 {ExprLooksLikeInt procedure} {
set x 0o289
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string "0o289" as operand of "+"}}
+} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.3 {ExprLooksLikeInt procedure} {
list [catch {expr 0289.1} msg] $msg
} {0 289.1}
@@ -1003,11 +1003,11 @@ test expr-old-36.11 {ExprLooksLikeInt procedure} {
test expr-old-36.12 {ExprLooksLikeInt procedure} {
set x "10;"
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string "10;" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.13 {ExprLooksLikeInt procedure} {
set x " +"
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string " +" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-old-36.14 {ExprLooksLikeInt procedure} {
set x "123456789012345678901234567890 "
expr {$x+1}
@@ -1015,7 +1015,7 @@ test expr-old-36.14 {ExprLooksLikeInt procedure} {
test expr-old-36.15 {ExprLooksLikeInt procedure} {
set x "0o99 "
list [catch {expr {$x+1}} msg] $msg
-} {1 {can't use non-numeric string "0o99 " as operand of "+"}}
+} {1 {can't use invalid octal number as operand of "+"}}
test expr-old-36.16 {ExprLooksLikeInt procedure} {
set x " 0xffffffffffffffffffffffffffffffffffffff "
expr {$x+1}
diff --git a/tests/expr.test b/tests/expr.test
index 664b479..8e083c5 100644
--- a/tests/expr.test
+++ b/tests/expr.test
@@ -257,7 +257,7 @@ test expr-4.9 {CompileLorExpr: long lor arm} {
} 1
test expr-4.10 {CompileLorExpr: error compiling ! operand} {
list [catch {expr {!"a"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
test expr-4.11 {CompileLorExpr: error compiling land arms} {
list [catch {expr {"a"||0}} msg] $msg
} {1 {expected boolean value but got "a"}}
@@ -304,10 +304,10 @@ test expr-6.8 {CompileBitXorExpr: error compiling bitxor arm} -body {
} -returnCodes error -match glob -result *
test expr-6.9 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {24.0^3}} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of "^"}}
+} {1 {can't use floating-point value as operand of "^"}}
test expr-6.10 {CompileBitXorExpr: runtime error in bitxor arm} {
list [catch {expr {"a"^"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "^"}}
+} {1 {can't use non-numeric string as operand of "^"}}
test expr-7.1 {CompileBitAndExpr: just equality expr} {expr 3==2} 0
test expr-7.2 {CompileBitAndExpr: just equality expr} {expr 2.0==2} 1
@@ -328,10 +328,10 @@ test expr-7.11 {CompileBitAndExpr: error compiling bitand arm} -body {
} -returnCodes error -match glob -result *
test expr-7.12 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {24.0&3}} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of "&"}}
+} {1 {can't use floating-point value as operand of "&"}}
test expr-7.13 {CompileBitAndExpr: runtime error in bitand arm} {
list [catch {expr {"a"&"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "&"}}
+} {1 {can't use non-numeric string as operand of "&"}}
test expr-7.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0
test expr-7.18 {CompileBitAndExpr: equality expr} {expr {"abc" eq "abd"}} 0
test expr-7.20 {CompileBitAndExpr: error in equality expr} -body {
@@ -456,10 +456,10 @@ test expr-10.9 {CompileShiftExpr: error compiling shift arm} -body {
} -returnCodes error -match glob -result *
test expr-10.10 {CompileShiftExpr: runtime error} {
list [catch {expr {24.0>>43}} msg] $msg
-} {1 {can't use floating-point value "24.0" as operand of ">>"}}
+} {1 {can't use floating-point value as operand of ">>"}}
test expr-10.11 {CompileShiftExpr: runtime error} {
list [catch {expr {"a"<<"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "<<"}}
+} {1 {can't use non-numeric string as operand of "<<"}}
test expr-11.1 {CompileAddExpr: just multiply expr} {expr 4*-2} -8
test expr-11.2 {CompileAddExpr: just multiply expr} {expr 0xff%2} 1
@@ -478,10 +478,10 @@ test expr-11.9 {CompileAddExpr: error compiling add arm} -body {
} -returnCodes error -match glob -result *
test expr-11.10 {CompileAddExpr: runtime error} {
list [catch {expr {24.0+"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test expr-11.11 {CompileAddExpr: runtime error} {
list [catch {expr {"a"-"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "-"}}
+} {1 {can't use non-numeric string as operand of "-"}}
test expr-11.12 {CompileAddExpr: runtime error} {
list [catch {expr {3/0}} msg] $msg
} {1 {divide by zero}}
@@ -509,10 +509,10 @@ test expr-12.9 {CompileMultiplyExpr: error compiling multiply arm} -body {
} -returnCodes error -match glob -result *
test expr-12.10 {CompileMultiplyExpr: runtime error} {
list [catch {expr {24.0*"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "*"}}
+} {1 {can't use non-numeric string as operand of "*"}}
test expr-12.11 {CompileMultiplyExpr: runtime error} {
list [catch {expr {"a"/"b"}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "/"}}
+} {1 {can't use non-numeric string as operand of "/"}}
test expr-13.1 {CompileUnaryExpr: unary exprs} {expr -0xff} -255
test expr-13.2 {CompileUnaryExpr: unary exprs} {expr +0o00123} 83
@@ -529,10 +529,10 @@ test expr-13.9 {CompileUnaryExpr: error compiling unary expr} -body {
} -returnCodes error -match glob -result *
test expr-13.10 {CompileUnaryExpr: runtime error} {
list [catch {expr {~"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "~"}}
+} {1 {can't use non-numeric string as operand of "~"}}
test expr-13.11 {CompileUnaryExpr: runtime error} {
list [catch {expr ~4.0} msg] $msg
-} {1 {can't use floating-point value "4.0" as operand of "~"}}
+} {1 {can't use floating-point value as operand of "~"}}
test expr-13.12 {CompileUnaryExpr: just primary expr} {expr 0x123} 291
test expr-13.13 {CompileUnaryExpr: just primary expr} {
set a 27
@@ -844,15 +844,15 @@ test expr-21.13 {non-numeric boolean literals} -body {
} -returnCodes error -match glob -result *
test expr-21.14 {non-numeric boolean literals} {
list [catch {expr !"truef"} err] $err
-} {1 {can't use non-numeric string "truef" as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.15 {non-numeric boolean variables} {
set v truef
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string "truef" as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.16 {non-numeric boolean variables} {
set v "true "
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string "true " as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.17 {non-numeric boolean variables} {
set v "tru"
list [catch {expr {!$v}} err] $err
@@ -872,23 +872,23 @@ test expr-21.20 {non-numeric boolean variables} {
test expr-21.21 {non-numeric boolean variables} {
set v "o"
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string "o" as operand of "!"}}
+} {1 {can't use non-numeric string as operand of "!"}}
test expr-21.22 {non-numeric boolean variables} {
set v ""
list [catch {expr {!$v}} err] $err
-} {1 {can't use non-numeric string "" as operand of "!"}}
+} {1 {can't use empty string as operand of "!"}}
# Test for non-numeric float handling.
test expr-22.1 {non-numeric floats} {
list [catch {expr {NaN + 1}} msg] $msg
-} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
+} {1 {can't use non-numeric floating-point value as operand of "+"}}
test expr-22.2 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr {Inf + 1}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "+"}}
test expr-22.3 {non-numeric floats} {
set nan NaN
list [catch {expr {$nan + 1}} msg] $msg
-} {1 {can't use non-numeric floating-point value "NaN" as operand of "+"}}
+} {1 {can't use non-numeric floating-point value as operand of "+"}}
test expr-22.4 {non-numeric floats} !ieeeFloatingPoint {
set inf Inf
list [catch {expr {$inf + 1}} msg] $msg
@@ -901,7 +901,7 @@ test expr-22.6 {non-numeric floats} !ieeeFloatingPoint {
} {1 {floating-point value too large to represent}}
test expr-22.7 {non-numeric floats} {
list [catch {expr {1 / NaN}} msg] $msg
-} {1 {can't use non-numeric floating-point value "NaN" as operand of "/"}}
+} {1 {can't use non-numeric floating-point value as operand of "/"}}
test expr-22.8 {non-numeric floats} !ieeeFloatingPoint {
list [catch {expr {1 / Inf}} msg] $msg
} {1 {can't use infinite floating-point value as operand of "/"}}
@@ -937,10 +937,10 @@ test expr-23.8 {CompileExponentialExpr: error compiling expo arm} -body {
} -returnCodes error -match glob -result *
test expr-23.9 {CompileExponentialExpr: runtime error} {
list [catch {expr {24.0**"xx"}} msg] $msg
-} {1 {can't use non-numeric string "xx" as operand of "**"}}
+} {1 {can't use non-numeric string as operand of "**"}}
test expr-23.10 {CompileExponentialExpr: runtime error} {
list [catch {expr {"a"**2}} msg] $msg
-} {1 {can't use non-numeric string "a" as operand of "**"}}
+} {1 {can't use non-numeric string as operand of "**"}}
test expr-23.11 {CompileExponentialExpr: runtime error} {
list [catch {expr {0**-1}} msg] $msg
} {1 {exponentiation of zero by negative power}}
diff --git a/tests/get.test b/tests/get.test
index c82b7e5..d6a7206 100644
--- a/tests/get.test
+++ b/tests/get.test
@@ -98,17 +98,17 @@ test get-3.2 {Tcl_GetDouble(FromObj), bad numbers} {
} {0 1 0 1 1 {expected floating-point number but got "++1.0"} 1 {expected floating-point number but got "+-1.0"} 1 {expected floating-point number but got "-+1.0"} 0 -1 1 {expected floating-point number but got "--1.0"} 1 {expected floating-point number but got "- +1.0"}}
# Bug 7114ac6141
test get-3.3 {tcl_GetInt with iffy numbers} testgetint {
- lmap x {0 " 0" "0 " " 0 " " 0xa " " 010 " " 0o10 " " 0b10 "} {
+ lmap x {0 " 0" "0 " " 0 " " 0xa " " 007 " " 0o10 " " 0b10 "} {
catch {testgetint 44 $x} x
set x
}
-} {44 44 44 44 54 54 52 46}
+} {44 44 44 44 54 51 52 46}
test get-3.4 {Tcl_GetDouble with iffy numbers} testdoubleobj {
- lmap x {0 0.0 " .0" ".0 " " 0e0 " "09" "- 0" "-0" "0o12" "0b10"} {
+ lmap x {0 0.0 " .0" ".0 " " 0e0 " "07" "- 0" "-0" "0o12" "0b10"} {
catch {testdoubleobj set 1 $x} x
set x
}
-} {0.0 0.0 0.0 0.0 0.0 9.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
+} {0.0 0.0 0.0 0.0 0.0 7.0 {expected floating-point number but got "- 0"} 0.0 10.0 2.0}
# cleanup
::tcltest::cleanupTests
diff --git a/tests/lindex.test b/tests/lindex.test
index 4802e28..29eb898 100644
--- a/tests/lindex.test
+++ b/tests/lindex.test
@@ -70,11 +70,11 @@ test lindex-3.4 {integer 3} testevalex {
test lindex-3.5 {bad octal} -constraints testevalex -body {
set x 0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-3.6 {bad octal} -constraints testevalex -body {
set x -0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-3.7 {indexes don't shimmer wide ints} {
set x [expr {(wide(1)<<31) - 2}]
list $x [lindex {1 2 3} $x] [incr x] [incr x]
@@ -105,11 +105,11 @@ test lindex-4.5 {index = end-3} testevalex {
test lindex-4.6 {bad octal} -constraints testevalex -body {
set x end-0o8
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-4.7 {bad octal} -constraints testevalex -body {
set x end--0o9
list [catch { testevalex {lindex {a b c} $x} } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-4.8 {bad integer, not octal} testevalex {
set x end-0a2
list [catch { testevalex {lindex {a b c} $x} } result] $result
@@ -261,11 +261,11 @@ test lindex-11.4 {integer 3} {
test lindex-11.5 {bad octal} -body {
set x 0o8
list [catch { lindex {a b c} $x } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-11.6 {bad octal} -body {
set x -0o9
list [catch { lindex {a b c} $x } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
# Indices relative to end
@@ -307,11 +307,11 @@ test lindex-12.5 {index = end-3} {
test lindex-12.6 {bad octal} -body {
set x end-0o8
list [catch { lindex {a b c} $x } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-12.7 {bad octal} -body {
set x end--0o9
list [catch { lindex {a b c} $x } result] $result
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test lindex-12.8 {bad integer, not octal} {
set x end-0a2
list [catch { lindex {a b c} $x } result] $result
diff --git a/tests/mathop.test b/tests/mathop.test
index 0808d42..f122b7b 100644
--- a/tests/mathop.test
+++ b/tests/mathop.test
@@ -114,22 +114,22 @@ namespace eval ::testmathop {
test mathop-1.10 {compiled +} { + 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.11 {compiled +: errors} -returnCodes error -body {
+ x 0
- } -result {can't use non-numeric string "x" as operand of "+"}
+ } -result {can't use non-numeric string as operand of "+"}
test mathop-1.12 {compiled +: errors} -returnCodes error -body {
+ nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
+ } -result {can't use non-numeric floating-point value as operand of "+"}
test mathop-1.13 {compiled +: errors} -returnCodes error -body {
+ 0 x
- } -result {can't use non-numeric string "x" as operand of "+"}
+ } -result {can't use non-numeric string as operand of "+"}
test mathop-1.14 {compiled +: errors} -returnCodes error -body {
+ 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
+ } -result {can't use non-numeric floating-point value as operand of "+"}
test mathop-1.15 {compiled +: errors} -returnCodes error -body {
+ 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "+"}
+ } -result {can't use invalid octal number as operand of "+"}
test mathop-1.16 {compiled +: errors} -returnCodes error -body {
+ 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "+"}
+ } -result {can't use invalid octal number as operand of "+"}
test mathop-1.17 {compiled +: errors} -returnCodes error -body {
+ 0 [error expectedError]
} -result expectedError
@@ -152,22 +152,22 @@ namespace eval ::testmathop {
test mathop-1.28 {interpreted +} { $op 1 2 3000000000000000000000 } 3000000000000000000003
test mathop-1.29 {interpreted +: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string "x" as operand of "+"}
+ } -result {can't use non-numeric string as operand of "+"}
test mathop-1.30 {interpreted +: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
+ } -result {can't use non-numeric floating-point value as operand of "+"}
test mathop-1.31 {interpreted +: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string "x" as operand of "+"}
+ } -result {can't use non-numeric string as operand of "+"}
test mathop-1.32 {interpreted +: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "+"}
+ } -result {can't use non-numeric floating-point value as operand of "+"}
test mathop-1.33 {interpreted +: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "+"}
+ } -result {can't use invalid octal number as operand of "+"}
test mathop-1.34 {interpreted +: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "+"}
+ } -result {can't use invalid octal number as operand of "+"}
test mathop-1.35 {interpreted +: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -189,22 +189,22 @@ namespace eval ::testmathop {
test mathop-2.10 {compiled *} { * 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.11 {compiled *: errors} -returnCodes error -body {
* x 0
- } -result {can't use non-numeric string "x" as operand of "*"}
+ } -result {can't use non-numeric string as operand of "*"}
test mathop-2.12 {compiled *: errors} -returnCodes error -body {
* nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
+ } -result {can't use non-numeric floating-point value as operand of "*"}
test mathop-2.13 {compiled *: errors} -returnCodes error -body {
* 0 x
- } -result {can't use non-numeric string "x" as operand of "*"}
+ } -result {can't use non-numeric string as operand of "*"}
test mathop-2.14 {compiled *: errors} -returnCodes error -body {
* 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
+ } -result {can't use non-numeric floating-point value as operand of "*"}
test mathop-2.15 {compiled *: errors} -returnCodes error -body {
* 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "*"}
+ } -result {can't use invalid octal number as operand of "*"}
test mathop-2.16 {compiled *: errors} -returnCodes error -body {
* 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "*"}
+ } -result {can't use invalid octal number as operand of "*"}
test mathop-2.17 {compiled *: errors} -returnCodes error -body {
* 0 [error expectedError]
} -result expectedError
@@ -227,22 +227,22 @@ namespace eval ::testmathop {
test mathop-2.28 {interpreted *} { $op 1 2 3000000000000000000000 } 6000000000000000000000
test mathop-2.29 {interpreted *: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string "x" as operand of "*"}
+ } -result {can't use non-numeric string as operand of "*"}
test mathop-2.30 {interpreted *: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
+ } -result {can't use non-numeric floating-point value as operand of "*"}
test mathop-2.31 {interpreted *: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string "x" as operand of "*"}
+ } -result {can't use non-numeric string as operand of "*"}
test mathop-2.32 {interpreted *: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "*"}
+ } -result {can't use non-numeric floating-point value as operand of "*"}
test mathop-2.33 {interpreted *: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "*"}
+ } -result {can't use invalid octal number as operand of "*"}
test mathop-2.34 {interpreted *: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "*"}
+ } -result {can't use invalid octal number as operand of "*"}
test mathop-2.35 {interpreted *: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -261,7 +261,7 @@ namespace eval ::testmathop {
test mathop-3.7 {compiled !} {! 10000000000000000000000000} 0
test mathop-3.8 {compiled !: errors} -body {
! foobar
- } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
+ } -returnCodes error -result {can't use non-numeric string as operand of "!"}
test mathop-3.9 {compiled !: errors} -body {
! 0 0
} -returnCodes error -result "wrong # args: should be \"! boolean\""
@@ -278,7 +278,7 @@ namespace eval ::testmathop {
test mathop-3.17 {interpreted !} {$op 10000000000000000000000000} 0
test mathop-3.18 {interpreted !: errors} -body {
$op foobar
- } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "!"}
+ } -returnCodes error -result {can't use non-numeric string as operand of "!"}
test mathop-3.19 {interpreted !: errors} -body {
$op 0 0
} -returnCodes error -result "wrong # args: should be \"! boolean\""
@@ -287,10 +287,10 @@ namespace eval ::testmathop {
} -returnCodes error -result "wrong # args: should be \"! boolean\""
test mathop-3.21 {compiled !: error} -returnCodes error -body {
! NaN
- } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
+ } -result {can't use non-numeric floating-point value as operand of "!"}
test mathop-3.22 {interpreted !: error} -returnCodes error -body {
$op NaN
- } -result {can't use non-numeric floating-point value "NaN" as operand of "!"}
+ } -result {can't use non-numeric floating-point value as operand of "!"}
test mathop-4.1 {compiled ~} {~ 0} -1
test mathop-4.2 {compiled ~} {~ 1} -2
@@ -301,7 +301,7 @@ namespace eval ::testmathop {
test mathop-4.7 {compiled ~} {~ 10000000000000000000000000} -10000000000000000000000001
test mathop-4.8 {compiled ~: errors} -body {
~ foobar
- } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
+ } -returnCodes error -result {can't use non-numeric string as operand of "~"}
test mathop-4.9 {compiled ~: errors} -body {
~ 0 0
} -returnCodes error -result "wrong # args: should be \"~ integer\""
@@ -310,10 +310,10 @@ namespace eval ::testmathop {
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.11 {compiled ~: errors} -returnCodes error -body {
~ 0.0
- } -result {can't use floating-point value "0.0" as operand of "~"}
+ } -result {can't use floating-point value as operand of "~"}
test mathop-4.12 {compiled ~: errors} -returnCodes error -body {
~ NaN
- } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
+ } -result {can't use non-numeric floating-point value as operand of "~"}
set op ~
test mathop-4.13 {interpreted ~} {$op 0} -1
test mathop-4.14 {interpreted ~} {$op 1} -2
@@ -324,7 +324,7 @@ namespace eval ::testmathop {
test mathop-4.19 {interpreted ~} {$op 10000000000000000000000000} -10000000000000000000000001
test mathop-4.20 {interpreted ~: errors} -body {
$op foobar
- } -returnCodes error -result {can't use non-numeric string "foobar" as operand of "~"}
+ } -returnCodes error -result {can't use non-numeric string as operand of "~"}
test mathop-4.21 {interpreted ~: errors} -body {
$op 0 0
} -returnCodes error -result "wrong # args: should be \"~ integer\""
@@ -333,10 +333,10 @@ namespace eval ::testmathop {
} -returnCodes error -result "wrong # args: should be \"~ integer\""
test mathop-4.23 {interpreted ~: errors} -returnCodes error -body {
$op 0.0
- } -result {can't use floating-point value "0.0" as operand of "~"}
+ } -result {can't use floating-point value as operand of "~"}
test mathop-4.24 {interpreted ~: errors} -returnCodes error -body {
$op NaN
- } -result {can't use non-numeric floating-point value "NaN" as operand of "~"}
+ } -result {can't use non-numeric floating-point value as operand of "~"}
test mathop-5.1 {compiled eq} {eq {} a} 0
test mathop-5.2 {compiled eq} {eq a a} 1
@@ -377,32 +377,32 @@ namespace eval ::testmathop {
test mathop-6.4 {compiled &} { & 3 7 6 } 2
test mathop-6.5 {compiled &} -returnCodes error -body {
& 1.0 2 3
- } -result {can't use floating-point value "1.0" as operand of "&"}
+ } -result {can't use floating-point value as operand of "&"}
test mathop-6.6 {compiled &} -returnCodes error -body {
& 1 2 3.0
- } -result {can't use floating-point value "3.0" as operand of "&"}
+ } -result {can't use floating-point value as operand of "&"}
test mathop-6.7 {compiled &} { & 100000000002 18 -126 } 2
test mathop-6.8 {compiled &} { & 0xff 0o377 333333333333 } 85
test mathop-6.9 {compiled &} { & 1000000000000000000002 18 -126 } 2
test mathop-6.10 {compiled &} { & 0xff 0o377 3333333333333333333333 } 85
test mathop-6.11 {compiled &: errors} -returnCodes error -body {
& x 0
- } -result {can't use non-numeric string "x" as operand of "&"}
+ } -result {can't use non-numeric string as operand of "&"}
test mathop-6.12 {compiled &: errors} -returnCodes error -body {
& nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
+ } -result {can't use non-numeric floating-point value as operand of "&"}
test mathop-6.13 {compiled &: errors} -returnCodes error -body {
& 0 x
- } -result {can't use non-numeric string "x" as operand of "&"}
+ } -result {can't use non-numeric string as operand of "&"}
test mathop-6.14 {compiled &: errors} -returnCodes error -body {
& 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
+ } -result {can't use non-numeric floating-point value as operand of "&"}
test mathop-6.15 {compiled &: errors} -returnCodes error -body {
& 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "&"}
+ } -result {can't use invalid octal number as operand of "&"}
test mathop-6.16 {compiled &: errors} -returnCodes error -body {
& 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "&"}
+ } -result {can't use invalid octal number as operand of "&"}
test mathop-6.17 {compiled &: errors} -returnCodes error -body {
& 0 [error expectedError]
} -result expectedError
@@ -419,32 +419,32 @@ namespace eval ::testmathop {
test mathop-6.22 {interpreted &} { $op 3 7 6 } 2
test mathop-6.23 {interpreted &} -returnCodes error -body {
$op 1.0 2 3
- } -result {can't use floating-point value "1.0" as operand of "&"}
+ } -result {can't use floating-point value as operand of "&"}
test mathop-6.24 {interpreted &} -returnCodes error -body {
$op 1 2 3.0
- } -result {can't use floating-point value "3.0" as operand of "&"}
+ } -result {can't use floating-point value as operand of "&"}
test mathop-6.25 {interpreted &} { $op 100000000002 18 -126 } 2
test mathop-6.26 {interpreted &} { $op 0xff 0o377 333333333333 } 85
test mathop-6.27 {interpreted &} { $op 1000000000000000000002 18 -126 } 2
test mathop-6.28 {interpreted &} { $op 0xff 0o377 3333333333333333333333 } 85
test mathop-6.29 {interpreted &: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string "x" as operand of "&"}
+ } -result {can't use non-numeric string as operand of "&"}
test mathop-6.30 {interpreted &: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
+ } -result {can't use non-numeric floating-point value as operand of "&"}
test mathop-6.31 {interpreted &: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string "x" as operand of "&"}
+ } -result {can't use non-numeric string as operand of "&"}
test mathop-6.32 {interpreted &: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "&"}
+ } -result {can't use non-numeric floating-point value as operand of "&"}
test mathop-6.33 {interpreted &: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "&"}
+ } -result {can't use invalid octal number as operand of "&"}
test mathop-6.34 {interpreted &: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "&"}
+ } -result {can't use invalid octal number as operand of "&"}
test mathop-6.35 {interpreted &: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -487,32 +487,32 @@ namespace eval ::testmathop {
test mathop-7.4 {compiled |} { | 3 7 6 } 7
test mathop-7.5 {compiled |} -returnCodes error -body {
| 1.0 2 3
- } -result {can't use floating-point value "1.0" as operand of "|"}
+ } -result {can't use floating-point value as operand of "|"}
test mathop-7.6 {compiled |} -returnCodes error -body {
| 1 2 3.0
- } -result {can't use floating-point value "3.0" as operand of "|"}
+ } -result {can't use floating-point value as operand of "|"}
test mathop-7.7 {compiled |} { | 100000000002 18 -126 } -110
test mathop-7.8 {compiled |} { | 0xff 0o377 333333333333 } 333333333503
test mathop-7.9 {compiled |} { | 1000000000000000000002 18 -126 } -110
test mathop-7.10 {compiled |} { | 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.11 {compiled |: errors} -returnCodes error -body {
| x 0
- } -result {can't use non-numeric string "x" as operand of "|"}
+ } -result {can't use non-numeric string as operand of "|"}
test mathop-7.12 {compiled |: errors} -returnCodes error -body {
| nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
+ } -result {can't use non-numeric floating-point value as operand of "|"}
test mathop-7.13 {compiled |: errors} -returnCodes error -body {
| 0 x
- } -result {can't use non-numeric string "x" as operand of "|"}
+ } -result {can't use non-numeric string as operand of "|"}
test mathop-7.14 {compiled |: errors} -returnCodes error -body {
| 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
+ } -result {can't use non-numeric floating-point value as operand of "|"}
test mathop-7.15 {compiled |: errors} -returnCodes error -body {
| 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "|"}
+ } -result {can't use invalid octal number as operand of "|"}
test mathop-7.16 {compiled |: errors} -returnCodes error -body {
| 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "|"}
+ } -result {can't use invalid octal number as operand of "|"}
test mathop-7.17 {compiled |: errors} -returnCodes error -body {
| 0 [error expectedError]
} -result expectedError
@@ -529,32 +529,32 @@ namespace eval ::testmathop {
test mathop-7.22 {interpreted |} { $op 3 7 6 } 7
test mathop-7.23 {interpreted |} -returnCodes error -body {
$op 1.0 2 3
- } -result {can't use floating-point value "1.0" as operand of "|"}
+ } -result {can't use floating-point value as operand of "|"}
test mathop-7.24 {interpreted |} -returnCodes error -body {
$op 1 2 3.0
- } -result {can't use floating-point value "3.0" as operand of "|"}
+ } -result {can't use floating-point value as operand of "|"}
test mathop-7.25 {interpreted |} { $op 100000000002 18 -126 } -110
test mathop-7.26 {interpreted |} { $op 0xff 0o377 333333333333 } 333333333503
test mathop-7.27 {interpreted |} { $op 1000000000000000000002 18 -126 } -110
test mathop-7.28 {interpreted |} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333503
test mathop-7.29 {interpreted |: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string "x" as operand of "|"}
+ } -result {can't use non-numeric string as operand of "|"}
test mathop-7.30 {interpreted |: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
+ } -result {can't use non-numeric floating-point value as operand of "|"}
test mathop-7.31 {interpreted |: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string "x" as operand of "|"}
+ } -result {can't use non-numeric string as operand of "|"}
test mathop-7.32 {interpreted |: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "|"}
+ } -result {can't use non-numeric floating-point value as operand of "|"}
test mathop-7.33 {interpreted |: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "|"}
+ } -result {can't use invalid octal number as operand of "|"}
test mathop-7.34 {interpreted |: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "|"}
+ } -result {can't use invalid octal number as operand of "|"}
test mathop-7.35 {interpreted |: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -597,32 +597,32 @@ namespace eval ::testmathop {
test mathop-8.4 {compiled ^} { ^ 3 7 6 } 2
test mathop-8.5 {compiled ^} -returnCodes error -body {
^ 1.0 2 3
- } -result {can't use floating-point value "1.0" as operand of "^"}
+ } -result {can't use floating-point value as operand of "^"}
test mathop-8.6 {compiled ^} -returnCodes error -body {
^ 1 2 3.0
- } -result {can't use floating-point value "3.0" as operand of "^"}
+ } -result {can't use floating-point value as operand of "^"}
test mathop-8.7 {compiled ^} { ^ 100000000002 18 -126 } -100000000110
test mathop-8.8 {compiled ^} { ^ 0xff 0o377 333333333333 } 333333333333
test mathop-8.9 {compiled ^} { ^ 1000000000000000000002 18 -126 } -1000000000000000000110
test mathop-8.10 {compiled ^} { ^ 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.11 {compiled ^: errors} -returnCodes error -body {
^ x 0
- } -result {can't use non-numeric string "x" as operand of "^"}
+ } -result {can't use non-numeric string as operand of "^"}
test mathop-8.12 {compiled ^: errors} -returnCodes error -body {
^ nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
+ } -result {can't use non-numeric floating-point value as operand of "^"}
test mathop-8.13 {compiled ^: errors} -returnCodes error -body {
^ 0 x
- } -result {can't use non-numeric string "x" as operand of "^"}
+ } -result {can't use non-numeric string as operand of "^"}
test mathop-8.14 {compiled ^: errors} -returnCodes error -body {
^ 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
+ } -result {can't use non-numeric floating-point value as operand of "^"}
test mathop-8.15 {compiled ^: errors} -returnCodes error -body {
^ 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "^"}
+ } -result {can't use invalid octal number as operand of "^"}
test mathop-8.16 {compiled ^: errors} -returnCodes error -body {
^ 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "^"}
+ } -result {can't use invalid octal number as operand of "^"}
test mathop-8.17 {compiled ^: errors} -returnCodes error -body {
^ 0 [error expectedError]
} -result expectedError
@@ -639,32 +639,32 @@ namespace eval ::testmathop {
test mathop-8.22 {interpreted ^} { $op 3 7 6 } 2
test mathop-8.23 {interpreted ^} -returnCodes error -body {
$op 1.0 2 3
- } -result {can't use floating-point value "1.0" as operand of "^"}
+ } -result {can't use floating-point value as operand of "^"}
test mathop-8.24 {interpreted ^} -returnCodes error -body {
$op 1 2 3.0
- } -result {can't use floating-point value "3.0" as operand of "^"}
+ } -result {can't use floating-point value as operand of "^"}
test mathop-8.25 {interpreted ^} { $op 100000000002 18 -126 } -100000000110
test mathop-8.26 {interpreted ^} { $op 0xff 0o377 333333333333 } 333333333333
test mathop-8.27 {interpreted ^} { $op 1000000000000000000002 18 -126 } -1000000000000000000110
test mathop-8.28 {interpreted ^} { $op 0xff 0o377 3333333333333333333333 } 3333333333333333333333
test mathop-8.29 {interpreted ^: errors} -returnCodes error -body {
$op x 0
- } -result {can't use non-numeric string "x" as operand of "^"}
+ } -result {can't use non-numeric string as operand of "^"}
test mathop-8.30 {interpreted ^: errors} -returnCodes error -body {
$op nan 0
- } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
+ } -result {can't use non-numeric floating-point value as operand of "^"}
test mathop-8.31 {interpreted ^: errors} -returnCodes error -body {
$op 0 x
- } -result {can't use non-numeric string "x" as operand of "^"}
+ } -result {can't use non-numeric string as operand of "^"}
test mathop-8.32 {interpreted ^: errors} -returnCodes error -body {
$op 0 nan
- } -result {can't use non-numeric floating-point value "nan" as operand of "^"}
+ } -result {can't use non-numeric floating-point value as operand of "^"}
test mathop-8.33 {interpreted ^: errors} -returnCodes error -body {
$op 0o8 0
- } -result {can't use non-numeric string "0o8" as operand of "^"}
+ } -result {can't use invalid octal number as operand of "^"}
test mathop-8.34 {interpreted ^: errors} -returnCodes error -body {
$op 0 0o8
- } -result {can't use non-numeric string "0o8" as operand of "^"}
+ } -result {can't use invalid octal number as operand of "^"}
test mathop-8.35 {interpreted ^: errors} -returnCodes error -body {
$op 0 [error expectedError]
} -result expectedError
@@ -775,13 +775,13 @@ test mathop-20.6 { one arg, error } {
# skipping - for now, knownbug...
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op {*}$vals]
- lappend exp "can't use non-numeric string \"x\" as operand of \"$op\"\
+ lappend exp "can't use non-numeric string as operand of \"$op\"\
ARITH DOMAIN {non-numeric string}"
}
}
foreach op {+ * / & | ^ **} {
lappend res [TestOp $op NaN 1]
- lappend exp "can't use non-numeric floating-point value \"NaN\" as operand of \"$op\"\
+ lappend exp "can't use non-numeric floating-point value as operand of \"$op\"\
ARITH DOMAIN {non-numeric floating-point value}"
}
expr {$res eq $exp ? 0 : $res}
@@ -850,15 +850,15 @@ test mathop-21.5 { unary ops, bad values } {
set res {}
set exp {}
lappend res [TestOp / x]
- lappend exp "can't use non-numeric string \"x\" as operand of \"/\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"/\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp - x]
- lappend exp "can't use non-numeric string \"x\" as operand of \"-\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"-\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ~ x]
- lappend exp "can't use non-numeric string \"x\" as operand of \"~\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"~\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ! x]
- lappend exp "can't use non-numeric string \"x\" as operand of \"!\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"!\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ~ 5.0]
- lappend exp "can't use floating-point value \"5.0\" as operand of \"~\" ARITH DOMAIN {floating-point value}"
+ lappend exp "can't use floating-point value as operand of \"~\" ARITH DOMAIN {floating-point value}"
expr {$res eq $exp ? 0 : $res}
} 0
test mathop-21.6 { unary ops, too many } {
@@ -965,9 +965,9 @@ test mathop-22.4 { unary ops, bad values } {
set exp {}
foreach op {& | ^} {
lappend res [TestOp $op x 5]
- lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp $op 5 x]
- lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
}
expr {$res eq $exp ? 0 : $res}
} 0
@@ -1080,15 +1080,15 @@ test mathop-24.3 { binary ops, bad values } {
set exp {}
foreach op {% << >>} {
lappend res [TestOp $op x 1]
- lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp $op 1 x]
- lappend exp "can't use non-numeric string \"x\" as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"$op\" ARITH DOMAIN {non-numeric string}"
}
foreach op {% << >>} {
lappend res [TestOp $op 5.0 1]
- lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+ lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
lappend res [TestOp $op 1 5.0]
- lappend exp "can't use floating-point value \"5.0\" as operand of \"$op\" ARITH DOMAIN {floating-point value}"
+ lappend exp "can't use floating-point value as operand of \"$op\" ARITH DOMAIN {floating-point value}"
}
foreach op {in ni} {
lappend res [TestOp $op 5 "a b \{ c"]
@@ -1240,9 +1240,9 @@ test mathop-25.23 { exp operator errors } {
lappend res [TestOp ** $huge 2.1]
lappend exp "Inf"
lappend res [TestOp ** 2 foo]
- lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
lappend res [TestOp ** foo 2]
- lappend exp "can't use non-numeric string \"foo\" as operand of \"**\" ARITH DOMAIN {non-numeric string}"
+ lappend exp "can't use non-numeric string as operand of \"**\" ARITH DOMAIN {non-numeric string}"
expr {$res eq $exp ? 0 : $res}
} 0
diff --git a/tests/namespace-old.test b/tests/namespace-old.test
index 3f8737b..1d6a805 100644
--- a/tests/namespace-old.test
+++ b/tests/namespace-old.test
@@ -293,13 +293,12 @@ namespace eval test_ns_hier1 {
namespace eval test_ns_hier2a {}
namespace eval test_ns_hier2b {}
}
-# TIP 278: secondary lookup disabled for vars, tests disabled with #
test namespace-old-5.4 {nested namespaces can access global namespace} {
- list [namespace eval test_ns_hier1 {#set test_ns_var_global}] \
+ list [namespace eval test_ns_hier1 {set test_ns_var_global}] \
[namespace eval test_ns_hier1 {test_ns_cmd_global}] \
- [namespace eval test_ns_hier1::test_ns_hier2 {#set test_ns_var_global}] \
+ [namespace eval test_ns_hier1::test_ns_hier2 {set test_ns_var_global}] \
[namespace eval test_ns_hier1::test_ns_hier2 {test_ns_cmd_global}]
-} {{} {cmd in ::} {} {cmd in ::}}
+} {{var in ::} {cmd in ::} {var in ::} {cmd in ::}}
test namespace-old-5.5 {variables in different namespaces don't conflict} {
list [set test_ns_hier1::test_ns_level] \
[set test_ns_hier1::test_ns_hier2::test_ns_level]
@@ -469,12 +468,11 @@ test namespace-old-6.11 {commands affect all parent namespaces} {
}
list [test_ns_cache1::trigger] [test_ns_cache1::test_ns_cache2::trigger]
} {{cache2 version} {cache2 version}}
-# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
test namespace-old-6.12 {define test variables} {
variable test_ns_cache_var "global version"
set trigger {set test_ns_cache_var}
- list [catch {namespace eval test_ns_cache1 $trigger} msg] $msg
-} {1 {can't read "test_ns_cache_var": no such variable}}
+ namespace eval test_ns_cache1 $trigger
+} {global version}
set trigger {set test_ns_cache_var}
test namespace-old-6.13 {one-level check for variable shadowing} {
namespace eval test_ns_cache1 {
@@ -483,24 +481,22 @@ test namespace-old-6.13 {one-level check for variable shadowing} {
namespace eval test_ns_cache1 $trigger
} {cache1 version}
variable ::test_ns_cache_var "global version"
-# TIP 278: secondary lookup disabled, catch added, result changed from {global version}
test namespace-old-6.14 {deleting variables changes variable epoch} {
namespace eval test_ns_cache1 {
variable test_ns_cache_var "cache1 version"
}
list [namespace eval test_ns_cache1 $trigger] \
[namespace eval test_ns_cache1 {unset test_ns_cache_var}] \
- [catch {namespace eval test_ns_cache1 $trigger}]
-} {{cache1 version} {} 1}
-# TIP 278: secondary lookup disabled, catch added, result changed
+ [namespace eval test_ns_cache1 $trigger]
+} {{cache1 version} {} {global version}}
test namespace-old-6.15 {define test namespaces} {
namespace eval test_ns_cache2 {
variable test_ns_cache_var "global cache2 version"
}
set trigger2 {set test_ns_cache2::test_ns_cache_var}
- catch {list [namespace eval test_ns_cache1 $trigger2] \
- [namespace eval test_ns_cache1::test_ns_cache2 $trigger]}
-} 1
+ list [namespace eval test_ns_cache1 $trigger2] \
+ [namespace eval test_ns_cache1::test_ns_cache2 $trigger]
+} {{global cache2 version} {global version}}
set trigger2 {set test_ns_cache2::test_ns_cache_var}
test namespace-old-6.16 {public variables affect all parent namespaces} {
variable test_ns_cache1::test_ns_cache2::test_ns_cache_var "cache2 version"
diff --git a/tests/namespace.test b/tests/namespace.test
index 24c1c7d..f6f817b 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -46,9 +46,9 @@ test namespace-2.2 {Tcl_GetCurrentNamespace} {
set l {}
lappend l [namespace current]
namespace eval test_ns_1 {
- lappend ::l [namespace current]
+ lappend l [namespace current]
namespace eval foo {
- lappend ::l [namespace current]
+ lappend l [namespace current]
}
}
lappend l [namespace current]
@@ -633,8 +633,6 @@ test namespace-14.2 {TclGetNamespaceForQualName, invalid absolute names} -setup
[catch {namespace children test_ns_777} msg] $msg
}
} -result {1 {can't read "::test_ns_777::v": no such variable} 1 {namespace "test_ns_777" not found in "::test_ns_1"}}
-
-# TIP 278: secondary lookup disabled, results changed from {10 20}
test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
variable v 10
@@ -646,11 +644,9 @@ test namespace-14.3 {TclGetNamespaceForQualName, relative names} -setup {
}
} -body {
namespace eval test_ns_1 {
- # list $v $test_ns_2::v
- list [catch {set v} msg] $msg [catch {set test_ns_2::v} msg] $msg
+ list $v $test_ns_2::v
}
-} -result {1 {can't read "v": no such variable} 0 20}
-
+} -result {10 20}
test namespace-14.4 {TclGetNamespaceForQualName, relative ns names looked up only in current ns} {
namespace eval test_ns_1::test_ns_2 {
namespace eval foo {}
@@ -711,17 +707,15 @@ test namespace-14.11 {TclGetNamespaceForQualName, extra ::s are significant for
proc test_ns_1::test_ns_2:: {args} {return "\{\}: $args"}
lappend l [test_ns_1::test_ns_2:: hello]
} -result {1 {invalid command name "test_ns_1::test_ns_2::"} {{}: hello}}
-
-# TIP 278: secondary lookup disabled, added catch, result changed from y
test namespace-14.12 {TclGetNamespaceForQualName, extra ::s are significant for vars} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
} -body {
namespace eval test_ns_1 {
variable {}
- catch {set test_ns_1::(x) y} ::msg
+ set test_ns_1::(x) y
}
- list $::msg [catch {set test_ns_1::(x)} msg] $msg
-} -result {{can't set "test_ns_1::(x)": parent namespace doesn't exist} 1 {can't read "test_ns_1::(x)": no such variable}}
+ set test_ns_1::(x)
+} -result y
test namespace-14.13 {TclGetNamespaceForQualName, namespace other than global ns can't have empty name} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
} -returnCodes error -body {
@@ -894,15 +888,13 @@ test namespace-17.6 {Tcl_FindNamespaceVar, relative name found} -setup {
set x
}
} -result {777}
-
-# TIP 278: secondary lookup disabled, catch added, result changed from 314159
test namespace-17.7 {Tcl_FindNamespaceVar, relative name found} {
namespace eval test_ns_1 {
variable x 777
unset x
- list [catch {set x} msg] $msg ;# must not be global x now
+ set x ;# must be global x now
}
-} {1 {can't read "x": no such variable}}
+} {314159}
test namespace-17.8 {Tcl_FindNamespaceVar, relative name not found} -body {
namespace eval test_ns_1 {
set wuzzat
@@ -914,8 +906,6 @@ test namespace-17.9 {Tcl_FindNamespaceVar, relative name and TCL_GLOBAL_ONLY} {
}
set test_ns_1::a
} {hello}
-
-# TIP 278: secondary lookup disabled, result changed from 1
test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -setup {
namespace eval test_ns_1 {}
} -body {
@@ -929,7 +919,7 @@ test namespace-17.10 {Tcl_FindNamespaceVar, interference with cached varNames} -
namespace eval test_ns_1 set a 1
namespace delete test_ns_1
return $a
-} -result 0
+} -result 1
catch {unset a}
catch {unset x}
@@ -1550,8 +1540,6 @@ test namespace-34.6 {NamespaceWhichCmd, -command is default} -setup {
[namespace which ::test_ns_2::cmd2]
}
} -result {::foreach ::test_ns_3::p ::test_ns_3::cmd1 ::test_ns_2::cmd2}
-
-# TIP 278: secondary lookup disabled, catch added, result changed
test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
catch {namespace delete {*}[namespace children test_ns_*]}
namespace eval test_ns_1 {
@@ -1571,12 +1559,12 @@ test namespace-34.7 {NamespaceWhichCmd, variable lookup} -setup {
}
} -body {
namespace eval test_ns_3 {
- list [catch {namespace which -variable env } msg] $msg \
+ list [namespace which -variable env] \
[namespace which -variable v3] \
[namespace which -variable ::test_ns_2::v2] \
[catch {namespace which -variable ::test_ns_2::noSuchVar} msg] $msg
}
-} -result {0 {} ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
+} -result {::env ::test_ns_3::v3 ::test_ns_2::v2 0 {}}
test namespace-35.1 {FreeNsNameInternalRep, resulting ref count > 0} -setup {
catch {namespace delete {*}[namespace children :: test_ns_*]}
diff --git a/tests/parse.test b/tests/parse.test
index d36472e..287c392 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -376,12 +376,12 @@ test parse-8.8 {Tcl_EvalObjv procedure, async handlers} -constraints {
return "new result"
}
set handler1 [testasync create async1]
- set ::aresult xxx
- set ::acode yyy
+ set aresult xxx
+ set acode yyy
} -cleanup {
testasync delete
} -body {
- list [testevalobjv 0 testasync mark $handler1 original 0] $::acode $::aresult
+ list [testevalobjv 0 testasync mark $handler1 original 0] $acode $aresult
} -result {{new result} 0 original}
test parse-8.9 {Tcl_EvalObjv procedure, exceptional return} testevalobjv {
list [catch {testevalobjv 0 error message} msg] $msg
diff --git a/tests/result.test b/tests/result.test
index 1eff46e..859e546 100644
--- a/tests/result.test
+++ b/tests/result.test
@@ -31,7 +31,7 @@ test result-1.2 {Tcl_SaveInterpResult} {testsaveresult} {
} {append result}
test result-1.3 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult dynamic {set x 42} 0
-} {dynamic result freed}
+} {dynamic result presentOrFreed}
test result-1.4 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult object {set x 42} 0
} {object result same}
@@ -43,7 +43,7 @@ test result-1.6 {Tcl_SaveInterpResult} {testsaveresult} {
} {42}
test result-1.7 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult dynamic {set x 42} 1
-} {42 freed}
+} {42 presentOrFreed}
test result-1.8 {Tcl_SaveInterpResult} {testsaveresult} {
testsaveresult object {set x 42} 1
} {42 different}
diff --git a/tests/string.test b/tests/string.test
index e36ebae..cebaf4c 100644
--- a/tests/string.test
+++ b/tests/string.test
@@ -292,10 +292,10 @@ test string-5.16 {string index, bytearray object with string obj shimmering} {
} 0
test string-5.17 {string index, bad integer} -body {
list [catch {string index "abc" 0o8} msg] $msg
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test string-5.18 {string index, bad integer} -body {
list [catch {string index "abc" end-0o0289} msg] $msg
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test string-5.19 {string index, bytearray object out of bounds} {
string index [binary format I* {0x50515253 0x52}] -1
} {}
diff --git a/tests/stringComp.test b/tests/stringComp.test
index 3ce2b72..2aeb08e 100644
--- a/tests/stringComp.test
+++ b/tests/stringComp.test
@@ -355,11 +355,11 @@ test stringComp-5.16 {string index, bytearray object with string obj shimmering}
test stringComp-5.17 {string index, bad integer} -body {
proc foo {} {string index "abc" 0o8}
list [catch {foo} msg] $msg
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test stringComp-5.18 {string index, bad integer} -body {
proc foo {} {string index "abc" end-0o0289}
list [catch {foo} msg] $msg
-} -match glob -result {1 {*}}
+} -match glob -result {1 {*invalid octal number*}}
test stringComp-5.19 {string index, bytearray object out of bounds} {
proc foo {} {string index [binary format I* {0x50515253 0x52}] -1}
foo
diff --git a/tests/tcltest.test b/tests/tcltest.test
index cd3c621..728a018 100644
--- a/tests/tcltest.test
+++ b/tests/tcltest.test
@@ -544,7 +544,6 @@ set notReadableDir [file join [temporaryDirectory] notreadable]
set notWriteableDir [file join [temporaryDirectory] notwriteable]
makeDirectory notreadable
makeDirectory notwriteable
-
switch -- $::tcl_platform(platform) {
unix {
file attributes $notReadableDir -permissions 00333
diff --git a/tests/var.test b/tests/var.test
index e32dbcf..9816d98 100644
--- a/tests/var.test
+++ b/tests/var.test
@@ -247,11 +247,10 @@ test var-3.4 {MakeUpvar, my var has TCL_NAMESPACE_ONLY specified} -setup {
catch {unset ::test_ns_var::vv}
proc p {} {
# create namespace var vv linked to global a
- testupvar 2 a {} vv namespace
+ testupvar 1 a {} vv namespace
}
p
}
- # Modified: that should create a global var according to the docs!
list $test_ns_var::vv [set test_ns_var::vv 123] $a
} -result {456 123 123}
test var-3.5 {MakeUpvar, no call frame so my var will be in global :: ns} -setup {
@@ -443,7 +442,7 @@ test var-7.5 {Tcl_VariableObjCmd, value for last var is optional} -setup {
set six 666
namespace eval test_ns_var {
variable five 5 six
- lappend ::a $five
+ lappend a $five
}
lappend a $test_ns_var::five \
[set test_ns_var::six 6] [set test_ns_var::six] $six
@@ -470,9 +469,9 @@ test var-7.8 {Tcl_VariableObjCmd, if var already exists and no value is given, l
set a ""
namespace eval test_ns_var {
variable eight 8
- lappend ::a $eight
+ lappend a $eight
variable eight
- lappend ::a $eight
+ lappend a $eight
}
set a
} {8 8}
diff --git a/tests/while-old.test b/tests/while-old.test
index e33bd0b..ee17d0b 100644
--- a/tests/while-old.test
+++ b/tests/while-old.test
@@ -92,7 +92,7 @@ test while-old-4.3 {errors in while loops} {
test while-old-4.4 {errors in while loops} {
set err [catch {while {"a"+"b"} {error "loop aborted"}} msg]
list $err $msg
-} {1 {can't use non-numeric string "a" as operand of "+"}}
+} {1 {can't use non-numeric string as operand of "+"}}
test while-old-4.5 {errors in while loops} {
catch {unset x}
set x 1
diff --git a/tests/while.test b/tests/while.test
index c25b404..642ec93 100644
--- a/tests/while.test
+++ b/tests/while.test
@@ -32,7 +32,7 @@ test while-1.2 {TclCompileWhileCmd: error in test expression} -body {
} -match glob -result {*"while {$i<} break"}
test while-1.3 {TclCompileWhileCmd: error in test expression} -body {
while {"a"+"b"} {error "loop aborted"}
-} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
+} -returnCodes error -result {can't use non-numeric string as operand of "+"}
test while-1.4 {TclCompileWhileCmd: multiline test expr} -body {
set value 1
while {($tcl_platform(platform) != "foobar1") && \
@@ -343,7 +343,7 @@ test while-4.3 {while (not compiled): error in test expression} -body {
test while-4.4 {while (not compiled): error in test expression} -body {
set z while
$z {"a"+"b"} {error "loop aborted"}
-} -returnCodes error -result {can't use non-numeric string "a" as operand of "+"}
+} -returnCodes error -result {can't use non-numeric string as operand of "+"}
test while-4.5 {while (not compiled): multiline test expr} -body {
set value 1
set z while
diff --git a/tools/README b/tools/README
index 87a9af4..f4bf627 100644
--- a/tools/README
+++ b/tools/README
@@ -12,7 +12,7 @@ Generating HTML files.
The tcl-tk-man-html.tcl script from Robert Critchlow
generates a nice set of HTML with good cross references.
Use it like
- tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl9.0
+ tclsh tcl-tk-man-html.tcl --htmldir=/tmp/tcl8.2
This script is very picky about the organization of man pages,
effectively acting as a style enforcer.
diff --git a/tools/checkLibraryDoc.tcl b/tools/checkLibraryDoc.tcl
index a220ea8..6d147ac 100755
--- a/tools/checkLibraryDoc.tcl
+++ b/tools/checkLibraryDoc.tcl
@@ -3,7 +3,7 @@
# This script attempts to determine what APIs exist in the source base that
# have not been documented. By grepping through all of the doc/*.3 man
# pages, looking for "Pkg_*" (e.g., Tcl_ or Tk_), and comparing this list
-# against the list of Pkg_ APIs found in the source (e.g., tcl9.0/*/*.[ch])
+# against the list of Pkg_ APIs found in the source (e.g., tcl8.2/*/*.[ch])
# we create six lists:
# 1) APIs in Source not in Docs.
# 2) APIs in Docs not in Source.
@@ -106,7 +106,7 @@ proc main {} {
if {($len != 2) && ($len != 3)} {
puts "usage: $argv0 pkgName pkgDir \[outFile\]"
puts " pkgName == Tcl,Tk"
- puts " pkgDir == /home/surles/cvs/tcl9.0"
+ puts " pkgDir == /home/surles/cvs/tcl8.2"
exit 1
}
diff --git a/tools/configure b/tools/configure
index e125786..5903cc8 100755
--- a/tools/configure
+++ b/tools/configure
@@ -1681,7 +1681,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
-DEF_VER=9.0
+DEF_VER=8.7
# Check whether --with-tcl was given.
diff --git a/tools/configure.ac b/tools/configure.ac
index 7950578..3caa141 100644
--- a/tools/configure.ac
+++ b/tools/configure.ac
@@ -11,7 +11,7 @@ AC_PREREQ(2.69)
# not, assume that its top-level directory is a sibling of ours.
#--------------------------------------------------------------------
-DEF_VER=9.0
+DEF_VER=8.7
AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl $DEF_VER binaries from DIR], TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl$DEF_VER$TCL_PATCH_LEVEL/unix; pwd`)
if test ! -d $TCL_BIN_DIR; then
diff --git a/tools/tcl.hpj.in b/tools/tcl.hpj.in
index a3d1a49..08d411d 100644
--- a/tools/tcl.hpj.in
+++ b/tools/tcl.hpj.in
@@ -5,9 +5,9 @@ HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl90.cnt
+CNT=tcl87.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl90.hlp
+HLP=tcl87.hlp
[FILES]
tcl.rtf
diff --git a/tools/tcltk-man2html.tcl b/tools/tcltk-man2html.tcl
index 82a041c..b0c2d8f 100755
--- a/tools/tcltk-man2html.tcl
+++ b/tools/tcltk-man2html.tcl
@@ -4,7 +4,7 @@ if {[catch {package require Tcl 8.6-} msg]} {
puts stderr "ERROR: $msg"
puts stderr "If running this script from 'make html', set the\
NATIVE_TCLSH environment\nvariable to point to an installed\
- tclsh9.0 (or the equivalent tclsh90.exe\non Windows)."
+ tclsh8.7 (or the equivalent tclsh87.exe\non Windows)."
exit 1
}
@@ -22,7 +22,7 @@ if {[catch {package require Tcl 8.6-} msg]} {
# Copyright (c) 1995-1997 Roger E. Critchlow Jr
# Copyright (c) 2004-2010 Donal K. Fellows
-set ::Version "50/9.0"
+set ::Version "50/8.7"
set ::CSSFILE "docs.css"
##
diff --git a/unix/Makefile.in b/unix/Makefile.in
index 4e2ddc8..032b5ac 100644
--- a/unix/Makefile.in
+++ b/unix/Makefile.in
@@ -829,7 +829,7 @@ install-libraries: libraries
else true; \
fi; \
done;
- @for i in opt0.4 http1.0 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \
+ @for i in opt0.4 http1.0 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d "$(SCRIPT_INSTALL_DIR)"/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -849,21 +849,21 @@ install-libraries: libraries
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
done;
@echo "Installing package http 2.8.12 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/http-2.8.12.tm;
+ @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.12.tm;
@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
@for i in $(TOP_DIR)/library/opt/*.tcl ; \
do \
$(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
done;
@echo "Installing package msgcat 1.6.1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/msgcat-1.6.1.tm;
+ @$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.6.1.tm;
@echo "Installing package tcltest 2.4.1 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/tcltest-2.4.1.tm;
+ @$(INSTALL_DATA) $(TOP_DIR)/library/tcltest/tcltest.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/tcltest-2.4.1.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform-1.0.14.tm;
+ @$(INSTALL_DATA) $(TOP_DIR)/library/platform/platform.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform-1.0.14.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
- @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl9/9.0/platform/shell-1.1.4.tm;
+ @$(INSTALL_DATA) $(TOP_DIR)/library/platform/shell.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.4/platform/shell-1.1.4.tm;
@echo "Installing encoding files to $(SCRIPT_INSTALL_DIR)/encoding/";
@for i in $(TOP_DIR)/library/encoding/*.enc ; do \
@@ -2097,7 +2097,7 @@ alldist: dist
#--------------------------------------------------------------------------
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
-# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
+# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#
# Note that for platforms where this is important, it is more common to use a
diff --git a/unix/configure b/unix/configure
index 6b9cedf..129c283 100755
--- a/unix/configure
+++ b/unix/configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.69 for tcl 9.0.
+# Generated by GNU Autoconf 2.69 for tcl 8.7.
#
#
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
@@ -577,8 +577,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='tcl'
PACKAGE_TARNAME='tcl'
-PACKAGE_VERSION='9.0'
-PACKAGE_STRING='tcl 9.0'
+PACKAGE_VERSION='8.7'
+PACKAGE_STRING='tcl 8.7'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -1319,7 +1319,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures tcl 9.0 to adapt to many kinds of systems.
+\`configure' configures tcl 8.7 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1380,7 +1380,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of tcl 9.0:";;
+ short | recursive ) echo "Configuration of tcl 8.7:";;
esac
cat <<\_ACEOF
@@ -1494,7 +1494,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-tcl configure 9.0
+tcl configure 8.7
generated by GNU Autoconf 2.69
Copyright (C) 2012 Free Software Foundation, Inc.
@@ -1970,7 +1970,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by tcl $as_me 9.0, which was
+It was created by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -2322,10 +2322,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
-TCL_VERSION=9.0
-TCL_MAJOR_VERSION=9
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL="a0"
+TCL_VERSION=8.7
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
@@ -10966,7 +10966,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by tcl $as_me 9.0, which was
+This file was extended by tcl $as_me 8.7, which was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -11023,7 +11023,7 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-tcl config.status 9.0
+tcl config.status 8.7
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
diff --git a/unix/configure.ac b/unix/configure.ac
index bd7a0e4..e14d85e 100644
--- a/unix/configure.ac
+++ b/unix/configure.ac
@@ -3,7 +3,7 @@ dnl This file is an input file used by the GNU "autoconf" program to
dnl generate the file "configure", which is run during Tcl installation
dnl to configure the system for the local environment.
-AC_INIT([tcl],[9.0])
+AC_INIT([tcl],[8.7])
AC_PREREQ(2.69)
dnl This is only used when included from macosx/configure.ac
@@ -22,10 +22,10 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [
#endif /* _TCLCONFIG */])
])
-TCL_VERSION=9.0
-TCL_MAJOR_VERSION=9
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL="a0"
+TCL_VERSION=8.7
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VERSION=${TCL_VERSION}
EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"}
diff --git a/unix/tcl.spec b/unix/tcl.spec
index 0858ee7..265e4df 100644
--- a/unix/tcl.spec
+++ b/unix/tcl.spec
@@ -4,7 +4,7 @@
Name: tcl
Summary: Tcl scripting language development environment
-Version: 9.0a0
+Version: 8.7a2
Release: 2
License: BSD
Group: Development/Languages
diff --git a/win/Makefile.in b/win/Makefile.in
index e8b0ff6..a3275ba 100644
--- a/win/Makefile.in
+++ b/win/Makefile.in
@@ -630,7 +630,7 @@ install-libraries: libraries install-tzdata install-msgs
else true; \
fi; \
done;
- @for i in http1.0 opt0.4 encoding ../tcl9 ../tcl9/9.0 ../tcl9/9.0/platform; \
+ @for i in http1.0 opt0.4 encoding ../tcl8 ../tcl8/8.4 ../tcl8/8.4/platform ../tcl8/8.5 ../tcl8/8.6; \
do \
if [ ! -d $(SCRIPT_INSTALL_DIR)/$$i ] ; then \
echo "Making directory $(SCRIPT_INSTALL_DIR)/$$i"; \
@@ -658,20 +658,20 @@ install-libraries: libraries install-tzdata install-msgs
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
done;
@echo "Installing package http 2.8.12 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/http-2.8.12.tm;
+ @$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.12.tm;
@echo "Installing library opt0.4 directory";
@for j in $(ROOT_DIR)/library/opt/*.tcl; \
do \
$(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
done;
@echo "Installing package msgcat 1.6.1 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/msgcat-1.6.1.tm;
+ @$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.6.1.tm;
@echo "Installing package tcltest 2.4.0 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/tcltest-2.4.0.tm;
+ @$(COPY) $(ROOT_DIR)/library/tcltest/tcltest.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/tcltest-2.4.0.tm;
@echo "Installing package platform 1.0.14 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform-1.0.14.tm;
+ @$(COPY) $(ROOT_DIR)/library/platform/platform.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform-1.0.14.tm;
@echo "Installing package platform::shell 1.1.4 as a Tcl Module";
- @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl9/9.0/platform/shell-1.1.4.tm;
+ @$(COPY) $(ROOT_DIR)/library/platform/shell.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.4/platform/shell-1.1.4.tm;
@echo "Installing encodings";
@for i in $(ROOT_DIR)/library/encoding/*.enc ; do \
$(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)/encoding"; \
@@ -858,7 +858,7 @@ genstubs:
#
# This target creates the HTML folder for Tcl & Tk and places it in
# DISTDIR/html. It uses the tcltk-man2html.tcl tool from the Tcl group's tool
-# workspace. It depends on the Tcl & Tk being in directories called tcl9.* &
+# workspace. It depends on the Tcl & Tk being in directories called tcl8.* &
# tk8.* up two directories from the TOOL_DIR.
#
diff --git a/win/README b/win/README
index 022dc11..972923c 100644
--- a/win/README
+++ b/win/README
@@ -1,4 +1,4 @@
-Tcl 9.0 for Windows
+Tcl 8.7 for Windows
1. Introduction
---------------
@@ -16,7 +16,7 @@ The information in this file is maintained on the web at:
In order to compile Tcl for Windows, you need the following:
- Tcl 9.0 Source Distribution (plus any patches)
+ Tcl 8.7 Source Distribution (plus any patches)
and
@@ -79,9 +79,9 @@ Use the Makefile "install" target to install Tcl. It will install it
according to the prefix options you provided in the correct directory
structure.
-Note that in order to run tclsh90.exe, you must ensure that tcl90.dll is
+Note that in order to run tclsh87.exe, you must ensure that tcl87.dll is
on your path, in the system directory, or in the directory containing
-tclsh90.exe.
+tclsh87.exe.
Note: Tcl no longer provides support for Win32s.
diff --git a/win/configure b/win/configure
index 9554f3a..fdd3adb 100755
--- a/win/configure
+++ b/win/configure
@@ -2099,10 +2099,10 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=9.0
-TCL_MAJOR_VERSION=9
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL="a0"
+TCL_VERSION=8.7
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
diff --git a/win/configure.ac b/win/configure.ac
index 5804754..d03695c 100644
--- a/win/configure.ac
+++ b/win/configure.ac
@@ -11,10 +11,10 @@ AC_PREREQ(2.69)
# /bin/sh. The bash shell seems to suffer from some strange failures.
SHELL=/bin/sh
-TCL_VERSION=9.0
-TCL_MAJOR_VERSION=9
-TCL_MINOR_VERSION=0
-TCL_PATCH_LEVEL="a0"
+TCL_VERSION=8.7
+TCL_MAJOR_VERSION=8
+TCL_MINOR_VERSION=7
+TCL_PATCH_LEVEL="a2"
VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION
TCL_DDE_VERSION=1.4
diff --git a/win/makefile.vc b/win/makefile.vc
index ceedc10..2bff871 100644
--- a/win/makefile.vc
+++ b/win/makefile.vc
@@ -1116,12 +1116,16 @@ install-binaries:
install-libraries: tclConfig install-msgs install-tzdata
@if not exist "$(SCRIPT_INSTALL_DIR)$(NULL)" \
$(MKDIR) "$(SCRIPT_INSTALL_DIR)"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0"
- @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform$(NULL)" \
- $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5"
+ @if not exist "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6$(NULL)" \
+ $(MKDIR) "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6"
@echo Installing header files
@$(CPY) "$(GENERICDIR)\tcl.h" "$(INCLUDE_INSTALL_DIR)\"
@$(CPY) "$(GENERICDIR)\tclDecls.h" "$(INCLUDE_INSTALL_DIR)\"
@@ -1153,19 +1157,19 @@ install-libraries: tclConfig install-msgs install-tzdata
"$(SCRIPT_INSTALL_DIR)\opt0.4\"
@echo Installing package http $(PKG_HTTP_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\http\http.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\http-$(PKG_HTTP_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.6\http-$(PKG_HTTP_VER).tm"
@echo Installing package msgcat $(PKG_MSGCAT_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\msgcat\msgcat.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\msgcat-$(PKG_MSGCAT_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\msgcat-$(PKG_MSGCAT_VER).tm"
@echo Installing package tcltest $(PKG_TCLTEST_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\tcltest\tcltest.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\tcltest-$(PKG_TCLTEST_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.5\tcltest-$(PKG_TCLTEST_VER).tm"
@echo Installing package platform $(PKG_PLATFORM_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\platform\platform.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform-$(PKG_PLATFORM_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform-$(PKG_PLATFORM_VER).tm"
@echo Installing package platform::shell $(PKG_SHELL_VER) as a Tcl Module
@$(COPY) "$(ROOT)\library\platform\shell.tcl" \
- "$(SCRIPT_INSTALL_DIR)\..\tcl9\9.0\platform\shell-$(PKG_SHELL_VER).tm"
+ "$(SCRIPT_INSTALL_DIR)\..\tcl8\8.4\platform\shell-$(PKG_SHELL_VER).tm"
@echo Installing $(TCLDDELIBNAME)
!if $(STATIC_BUILD)
!if !$(TCL_USE_STATIC_PACKAGES)
diff --git a/win/tcl.hpj.in b/win/tcl.hpj.in
index a3d1a49..08d411d 100644
--- a/win/tcl.hpj.in
+++ b/win/tcl.hpj.in
@@ -5,9 +5,9 @@ HCW=0
LCID=0x409 0x0 0x0 ;English (United States)
REPORT=Yes
TITLE=Tcl/Tk Reference Manual
-CNT=tcl90.cnt
+CNT=tcl87.cnt
COPYRIGHT=Copyright © 2000 Ajuba Solutions
-HLP=tcl90.hlp
+HLP=tcl87.hlp
[FILES]
tcl.rtf
diff --git a/win/tcl.m4 b/win/tcl.m4
index 6701b1e..b4fbcce 100644
--- a/win/tcl.m4
+++ b/win/tcl.m4
@@ -1126,13 +1126,13 @@ AC_DEFUN([SC_CONFIG_CFLAGS], [
#------------------------------------------------------------------------
AC_DEFUN([SC_WITH_TCL], [
- if test -d ../../tcl9.0$1/win; then
- TCL_BIN_DEFAULT=../../tcl9.0$1/win
+ if test -d ../../tcl8.7$1/win; then
+ TCL_BIN_DEFAULT=../../tcl8.7$1/win
else
- TCL_BIN_DEFAULT=../../tcl9.0/win
+ TCL_BIN_DEFAULT=../../tcl8.7/win
fi
- AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 9.0 binaries from DIR],
+ AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.7 binaries from DIR],
TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DEFAULT; pwd`)
if test ! -d $TCL_BIN_DIR; then
AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)