From 76995b15620ca1eecef253001cd60a1a961b6605 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 2 May 2005 21:45:57 +0000 Subject: * generic/tcl.decls: * generic/tclBasic.c: Simplified implementation of Tcl_ExprString. * tests/expr-old.test: * generic/tclDecls.h: `make gentstubs` --- ChangeLog | 8 ++++++ generic/tcl.decls | 4 +-- generic/tclBasic.c | 71 ++++++++++++++--------------------------------------- generic/tclDecls.h | 6 ++--- tests/expr-old.test | 9 ++++++- 5 files changed, 40 insertions(+), 58 deletions(-) diff --git a/ChangeLog b/ChangeLog index 884c342..76777c6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2005-05-02 Don Porter + + * generic/tcl.decls: + * generic/tclBasic.c: Simplified implementation of Tcl_ExprString. + * tests/expr-old.test: + + * generic/tclDecls.h: `make gentstubs` + 2005-04-30 Daniel Steffen * unix/tclUnixNotfy.c: applied dkf's tkMacOSXNotify.c cleanup changes. diff --git a/generic/tcl.decls b/generic/tcl.decls index cd95420..05fe8f9 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -11,7 +11,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.108 2005/01/27 00:22:58 andreas_kupries Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.109 2005/05/02 21:45:58 dgp Exp $ library tcl @@ -509,7 +509,7 @@ declare 141 generic { Tcl_Obj **resultPtrPtr) } declare 142 generic { - int Tcl_ExprString(Tcl_Interp *interp, CONST char *string) + int Tcl_ExprString(Tcl_Interp *interp, CONST char *exprString) } declare 143 generic { void Tcl_Finalize(void) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 8df8d17..d216d2d 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.147 2005/04/22 15:46:52 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.148 2005/05/02 21:45:59 dgp Exp $ */ #include "tclInt.h" @@ -1801,8 +1801,7 @@ TclInvokeObjectCommand(clientData, interp, argc, argv) for (i = 0; i < argc; i++) { length = strlen(argv[i]); - TclNewObj(objPtr); - TclInitStringRep(objPtr, argv[i], length); + TclNewStringObj(objPtr, argv[i], length); Tcl_IncrRefCount(objPtr); objv[i] = objPtr; } @@ -4322,61 +4321,29 @@ TclObjInvoke(interp, objc, objv, flags) */ int -Tcl_ExprString(interp, string) +Tcl_ExprString(interp, exprString) Tcl_Interp *interp; /* Context in which to evaluate the * expression. */ - CONST char *string; /* Expression to evaluate. */ + CONST char *exprString; /* Expression to evaluate. */ { - register Tcl_Obj *exprPtr; - Tcl_Obj *resultPtr; - int length = strlen(string); - char buf[TCL_DOUBLE_SPACE]; - int result = TCL_OK; - - if (length > 0) { - TclNewObj(exprPtr); - TclInitStringRep(exprPtr, string, length); + int code = TCL_OK; + if (exprString[0] == '\0') { + /* An empty string. Just set the interpreter's result to 0. */ + Tcl_SetResult(interp, "0", TCL_VOLATILE); + } else { + Tcl_Obj *resultPtr, *exprPtr = Tcl_NewStringObj(exprString, -1); Tcl_IncrRefCount(exprPtr); - - result = Tcl_ExprObj(interp, exprPtr, &resultPtr); - if (result == TCL_OK) { - /* - * Set the interpreter's string result from the result object. - */ - - if (resultPtr->typePtr == &tclIntType) { - sprintf(buf, "%ld", resultPtr->internalRep.longValue); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else if (resultPtr->typePtr == &tclDoubleType) { - Tcl_PrintDouble((Tcl_Interp *) NULL, - resultPtr->internalRep.doubleValue, buf); - Tcl_SetResult(interp, buf, TCL_VOLATILE); - } else { - /* - * Set interpreter's string result from the result object. - */ - - Tcl_SetResult(interp, TclGetString(resultPtr), - TCL_VOLATILE); - } - Tcl_DecrRefCount(resultPtr); /* discard the result object */ - } else { - /* - * Move the interpreter's object result to the string result, - * then reset the object result. - */ - - (void) Tcl_GetStringResult(interp); + code = Tcl_ExprObj(interp, exprPtr, &resultPtr); + Tcl_DecrRefCount(exprPtr); + if (code == TCL_OK) { + Tcl_SetObjResult(interp, resultPtr); + Tcl_DecrRefCount(resultPtr); } - Tcl_DecrRefCount(exprPtr); /* discard the expression object */ - } else { - /* - * An empty string. Just set the interpreter's result to 0. - */ - - Tcl_SetResult(interp, "0", TCL_VOLATILE); + + /* Force the string rep of the interp result */ + (void) Tcl_GetStringResult(interp); } - return result; + return code; } /* diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 1226d00..6fe3188 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.110 2005/01/27 00:23:16 andreas_kupries Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.111 2005/05/02 21:45:59 dgp Exp $ */ #ifndef _TCLDECLS @@ -918,7 +918,7 @@ EXTERN int Tcl_ExprObj _ANSI_ARGS_((Tcl_Interp * interp, #define Tcl_ExprString_TCL_DECLARED /* 142 */ EXTERN int Tcl_ExprString _ANSI_ARGS_((Tcl_Interp * interp, - CONST char * string)); + CONST char * exprString)); #endif #ifndef Tcl_Finalize_TCL_DECLARED #define Tcl_Finalize_TCL_DECLARED @@ -3626,7 +3626,7 @@ typedef struct TclStubs { int (*tcl_ExprLong) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * str, long * ptr)); /* 139 */ int (*tcl_ExprLongObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, long * ptr)); /* 140 */ int (*tcl_ExprObj) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_Obj * objPtr, Tcl_Obj ** resultPtrPtr)); /* 141 */ - int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * string)); /* 142 */ + int (*tcl_ExprString) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * exprString)); /* 142 */ void (*tcl_Finalize) _ANSI_ARGS_((void)); /* 143 */ void (*tcl_FindExecutable) _ANSI_ARGS_((CONST char * argv0)); /* 144 */ Tcl_HashEntry * (*tcl_FirstHashEntry) _ANSI_ARGS_((Tcl_HashTable * tablePtr, Tcl_HashSearch * searchPtr)); /* 145 */ diff --git a/tests/expr-old.test b/tests/expr-old.test index 4f12a33..5690a14 100644 --- a/tests/expr-old.test +++ b/tests/expr-old.test @@ -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: expr-old.test,v 1.23 2005/01/28 13:38:59 dkf Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.24 2005/05/02 21:46:00 dgp Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -972,6 +972,13 @@ test expr-old-38.1 {Verify Tcl_ExprString's basic operation} testexprstring { list [testexprstring "1+4"] [testexprstring "2*3+4.2"] \ [catch {testexprstring "1+"} msg] $msg } {5 10.2 1 {syntax error in expression "1+": premature end of expression}} +test expr-old-38.2 {Tcl_ExprString} testexprstring { + # This one is "magical" + testexprstring {} +} 0 +test expr-old-38.3 {Tcl_ExprString} -constraints testexprstring -body { + testexprstring { } +} -returnCodes error -match glob -result * # # Test for bug #908375: rounding numbers that do not fit in a -- cgit v0.12