diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBasic.c | 10 | ||||
| -rw-r--r-- | generic/tclInt.h | 7 | ||||
| -rw-r--r-- | generic/tclTest.c | 45 | ||||
| -rw-r--r-- | tests/parse.test | 6 |
5 files changed, 21 insertions, 53 deletions
@@ -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..."}} |