summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2004-10-01 03:10:35 (GMT)
committerdgp <dgp@users.sourceforge.net>2004-10-01 03:10:35 (GMT)
commite4934a0b0d10dcb22c615f1ff62a6e596b753455 (patch)
treef8b35fdda3fe85388bcbea559accd2e74916e7d3
parent867b2ba591026b6f486b636329810e80b5069077 (diff)
downloadtcl-e4934a0b0d10dcb22c615f1ff62a6e596b753455.zip
tcl-e4934a0b0d10dcb22c615f1ff62a6e596b753455.tar.gz
tcl-e4934a0b0d10dcb22c615f1ff62a6e596b753455.tar.bz2
* generic/tclBasic.c (Tcl_EvalObjEx): Removed the flag bit value
* generic/tclInt.h (Interp): USE_EVAL_DIRECT. It was used only * generic/tcLTest.c (TestevalexObjCmd): in the testing command * tests/parser.test (parse-9.2): [testevalex] and nothing in the test suite made use of the capability it enabled.
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBasic.c10
-rw-r--r--generic/tclInt.h7
-rw-r--r--generic/tclTest.c45
-rw-r--r--tests/parse.test6
5 files changed, 21 insertions, 53 deletions
diff --git a/ChangeLog b/ChangeLog
index 06cfd7c..9c82d6d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
2004-09-30 Don Porter <dgp@users.sourceforge.net>
+ * generic/tclBasic.c (Tcl_EvalObjEx): Removed the flag bit value
+ * generic/tclInt.h (Interp): USE_EVAL_DIRECT. It was used only
+ * generic/tcLTest.c (TestevalexObjCmd): in the testing command
+ * tests/parser.test (parse-9.2): [testevalex] and nothing in the
+ test suite made use of the capability it enabled.
+
* generic/tclBasic.c (Tcl_AddObjErrorInfo): More re-organization
* generic/tclCmdAH.c (Tcl_ErrorObjCmd): of the management of
* generic/tclCmdMZ.c (TclProcessReturn): the errorCode value.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index ea3e03c..2d068fc 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclBasic.c,v 1.120 2004/09/30 23:06:47 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.121 2004/10/01 03:10:35 dgp Exp $
*/
#include "tclInt.h"
@@ -3786,7 +3786,7 @@ Tcl_EvalObjEx(interp, objPtr, flags)
Tcl_IncrRefCount(objPtr);
- if ((iPtr->flags & USE_EVAL_DIRECT) || (flags & TCL_EVAL_DIRECT)) {
+ if (flags & TCL_EVAL_DIRECT) {
/*
* We're not supposed to use the compiler or byte-code interpreter.
* Let Tcl_EvalEx evaluate the command directly (and probably
@@ -3797,12 +3797,8 @@ Tcl_EvalObjEx(interp, objPtr, flags)
* appreciable improvement in execution speed. This is because it
* allows us to avoid a setFromAny step that would just pack
* everything into a string and back out again.
- *
- * USE_EVAL_DIRECT is a special flag used for testing purpose only
- * (ensure we go into the TCL_EVAL_DIRECT path, avoiding opt)
*/
- if (!(iPtr->flags & USE_EVAL_DIRECT) &&
- (objPtr->typePtr == &tclListType) && /* is a list... */
+ if ((objPtr->typePtr == &tclListType) && /* is a list... */
(objPtr->bytes == NULL) /* ...without a string rep */) {
register List *listRepPtr =
(List *) objPtr->internalRep.twoPtrValue.ptr1;
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 249c96e..5721d0d 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.176 2004/09/29 22:17:31 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.177 2004/10/01 03:10:36 dgp Exp $
*/
#ifndef _TCLINT
@@ -1416,10 +1416,6 @@ typedef struct Interp {
* SAFE_INTERP: Non zero means that the current interp is a
* safe interp (ie it has only the safe commands
* installed, less priviledge than a regular interp).
- * USE_EVAL_DIRECT: Non-zero means don't use the compiler or byte-code
- * interpreter; instead, have Tcl_EvalObj call
- * Tcl_EvalEx. Used primarily for testing the
- * new parser.
* INTERP_TRACE_IN_PROGRESS: Non-zero means that an interp trace is currently
* active; so no further trace callbacks should be
* invoked.
@@ -1433,7 +1429,6 @@ typedef struct Interp {
#define DONT_COMPILE_CMDS_INLINE 0x20
#define RAND_SEED_INITIALIZED 0x40
#define SAFE_INTERP 0x80
-#define USE_EVAL_DIRECT 0x100
#define INTERP_TRACE_IN_PROGRESS 0x200
/*
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 96d18d9..e05d5cd 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclTest.c,v 1.83 2004/08/16 14:11:16 msofer Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.84 2004/10/01 03:10:36 dgp Exp $
*/
#define TCL_TEST
@@ -1927,31 +1927,14 @@ TestevalexObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- Interp *iPtr = (Interp *) interp;
- int code, oldFlags, length, flags;
- char *string;
-
- if (objc == 1) {
- /*
- * The command was invoked with no arguments, so just toggle
- * the flag that determines whether we use Tcl_EvalEx.
- */
-
- if (iPtr->flags & USE_EVAL_DIRECT) {
- iPtr->flags &= ~USE_EVAL_DIRECT;
- Tcl_SetResult(interp, "disabling direct evaluation", TCL_STATIC);
- } else {
- iPtr->flags |= USE_EVAL_DIRECT;
- Tcl_SetResult(interp, "enabling direct evaluation", TCL_STATIC);
- }
- return TCL_OK;
- }
+ int length, flags;
+ char *script;
flags = 0;
if (objc == 3) {
- string = Tcl_GetStringFromObj(objv[2], &length);
- if (strcmp(string, "global") != 0) {
- Tcl_AppendResult(interp, "bad value \"", string,
+ char *global = Tcl_GetStringFromObj(objv[2], &length);
+ if (strcmp(global, "global") != 0) {
+ Tcl_AppendResult(interp, "bad value \"", global,
"\": must be global", (char *) NULL);
return TCL_ERROR;
}
@@ -1960,21 +1943,9 @@ TestevalexObjCmd(dummy, interp, objc, objv)
Tcl_WrongNumArgs(interp, 1, objv, "script ?global?");
return TCL_ERROR;
}
- Tcl_SetResult(interp, "xxx", TCL_STATIC);
- /*
- * Note, we have to set the USE_EVAL_DIRECT flag in the interpreter
- * in addition to calling Tcl_EvalEx. This is needed so that even nested
- * commands are evaluated directly.
- */
-
- oldFlags = iPtr->flags;
- iPtr->flags |= USE_EVAL_DIRECT;
- string = Tcl_GetStringFromObj(objv[1], &length);
- code = Tcl_EvalEx(interp, string, length, flags);
- iPtr->flags = (iPtr->flags & ~USE_EVAL_DIRECT)
- | (oldFlags & USE_EVAL_DIRECT);
- return code;
+ script = Tcl_GetStringFromObj(objv[1], &length);
+ return Tcl_EvalEx(interp, script, length, flags);
}
/*
diff --git a/tests/parse.test b/tests/parse.test
index 2ae8152..619cfdd 100644
--- a/tests/parse.test
+++ b/tests/parse.test
@@ -8,7 +8,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: parse.test,v 1.18 2003/11/24 19:06:08 dgp Exp $
+# RCS: @(#) $Id: parse.test,v 1.19 2004/10/01 03:10:36 dgp Exp $
if {[catch {package require tcltest 2.0.2}]} {
puts stderr "Skipping tests in [info script]. tcltest 2.0.2 required."
@@ -392,8 +392,8 @@ test parse-9.1 {Tcl_LogCommandInfo, line numbers} testevalex {
# asdf
set x
}}"}}
-test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} testevalex {
- list [testevalex {catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}}] $errorInfo
+test parse-9.2 {Tcl_LogCommandInfo, truncating long commands} {
+ list [catch {set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd eeeeeeeee fffffffff ggggggggg}] $errorInfo
} {1 {wrong # args: should be "set varName ?newValue?"
while executing
"set a b 111111111 222222222 333333333 444444444 555555555 666666666 777777777 888888888 999999999 000000000 aaaaaaaaa bbbbbbbbb ccccccccc ddddddddd ee..."}}