* generic/tcl.decls:

        * generic/tclBasic.c:   Simplified implementation of Tcl_ExprString.
        * tests/expr-old.test:

        * generic/tclDecls.h:   `make gentstubs`

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