summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog8
-rw-r--r--generic/tcl.decls4
-rw-r--r--generic/tclBasic.c71
-rw-r--r--generic/tclDecls.h6
-rw-r--r--tests/expr-old.test9
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 <dgp@users.sourceforge.net>
+
+ * 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 <das@users.sourceforge.net>
* 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
generated by cgit v0.12 at 2024-07-22 01:18:02 (GMT)