diff options
author | Kevin B Kenny <kennykb@acm.org> | 2005-08-17 19:12:08 (GMT) |
---|---|---|
committer | Kevin B Kenny <kennykb@acm.org> | 2005-08-17 19:12:08 (GMT) |
commit | 4c6f56b153a8fee9a91e810871467af204ef97cb (patch) | |
tree | 1cab8c029830aa98730770a34e4ee1f9b833b6c2 | |
parent | 62674303e6bf1dead3698ea303ce186e36924d84 (diff) | |
download | tcl-4c6f56b153a8fee9a91e810871467af204ef97cb.zip tcl-4c6f56b153a8fee9a91e810871467af204ef97cb.tar.gz tcl-4c6f56b153a8fee9a91e810871467af204ef97cb.tar.bz2 |
updated Tcl_Expr* to deal with bignums
-rw-r--r-- | ChangeLog | 8 | ||||
-rw-r--r-- | generic/tclBasic.c | 160 | ||||
-rw-r--r-- | generic/tclTest.c | 145 | ||||
-rw-r--r-- | tests/expr-old.test | 93 | ||||
-rw-r--r-- | tests/expr.test | 109 |
5 files changed, 385 insertions, 130 deletions
@@ -1,3 +1,11 @@ +2005-08-17 Kevin Kenny <kennykb@users.sourceforge.net> + + * generic/tclBasic.c (Tcl_Expr{Long,Double}{,Obj}): Updated to + * tests/expr-old.test: deal with + * tests/expr.test: bignums (well, + mostly). Added test cases for Tcl_Expr* and Tcl_Expr*Obj because + there was very poor test coverage in those areas. + 2005-08-17 Don Porter <dgp@users.sourceforge.net> [kennykb_numerics_branch] diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 105ed6b..e599e2d 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.136.2.15 2005/08/15 20:46:02 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.136.2.16 2005/08/17 19:12:09 kennykb Exp $ */ #include "tclInt.h" @@ -4166,62 +4166,15 @@ Tcl_ExprLong(interp, exprstring, ptr) long *ptr; /* Where to store result. */ { register Tcl_Obj *exprPtr; - Tcl_Obj *resultPtr; - int length = strlen(exprstring); int result = TCL_OK; - - if (length > 0) { - exprPtr = Tcl_NewStringObj(exprstring, length); - Tcl_IncrRefCount(exprPtr); - result = Tcl_ExprObj(interp, exprPtr, &resultPtr); - if (result == TCL_OK) { - /* - * Store an integer based on the expression result. - */ - - if (resultPtr->typePtr == &tclIntType) { - *ptr = resultPtr->internalRep.longValue; - } else if (resultPtr->typePtr == &tclDoubleType) { - *ptr = (long) resultPtr->internalRep.doubleValue; - } else if (resultPtr->typePtr == &tclWideIntType) { -#ifndef TCL_WIDE_INT_IS_LONG - /* - * See Tcl_GetIntFromObj for conversion comments. - */ - Tcl_WideInt w = resultPtr->internalRep.wideValue; - if ((w >= -(Tcl_WideInt)(ULONG_MAX)) - && (w <= (Tcl_WideInt)(ULONG_MAX))) { - *ptr = Tcl_WideAsLong(w); - } else { - Tcl_SetResult(interp, - "integer value too large to represent as non-long integer", - TCL_STATIC); - result = TCL_ERROR; - } -#else - *ptr = resultPtr->internalRep.longValue; -#endif - } else { - Tcl_SetResult(interp, - "expression didn't have numeric value", TCL_STATIC); - result = TCL_ERROR; - } - 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); - } - Tcl_DecrRefCount(exprPtr); /* discard the expression object */ - } else { - /* - * An empty string. Just set the result integer to 0. - */ - + if (*exprstring == '\0') { + /* Legacy compatibility - return 0 for the zero-length string. */ *ptr = 0; + } else { + exprPtr = Tcl_NewStringObj(exprstring, -1); + Tcl_IncrRefCount(exprPtr); + result = Tcl_ExprLongObj(interp, exprPtr, ptr); + Tcl_DecrRefCount(exprPtr); } return result; } @@ -4234,62 +4187,16 @@ Tcl_ExprDouble(interp, exprstring, ptr) double *ptr; /* Where to store result. */ { register Tcl_Obj *exprPtr; - Tcl_Obj *resultPtr; - int length = strlen(exprstring); int result = TCL_OK; - if (length > 0) { - exprPtr = Tcl_NewStringObj(exprstring, length); + if (*exprstring == '\0') { + /* Legacy compatibility - return 0 for the zero-length string. */ + *ptr = 0.0; + } else { + exprPtr = Tcl_NewStringObj(exprstring, -1); Tcl_IncrRefCount(exprPtr); - result = Tcl_ExprObj(interp, exprPtr, &resultPtr); - if (result == TCL_OK) { - /* - * Store a double based on the expression result. - */ - - if (resultPtr->typePtr == &tclIntType) { - *ptr = (double) resultPtr->internalRep.longValue; - } else if (resultPtr->typePtr == &tclDoubleType) { - *ptr = resultPtr->internalRep.doubleValue; - } else if (resultPtr->typePtr == &tclWideIntType) { -#ifndef TCL_WIDE_INT_IS_LONG - /* - * See Tcl_GetIntFromObj for conversion comments. - */ - Tcl_WideInt w = resultPtr->internalRep.wideValue; - if ((w >= -(Tcl_WideInt)(ULONG_MAX)) - && (w <= (Tcl_WideInt)(ULONG_MAX))) { - *ptr = (double) Tcl_WideAsLong(w); - } else { - Tcl_SetResult(interp, - "integer value too large to represent as non-long integer", - TCL_STATIC); - result = TCL_ERROR; - } -#else - *ptr = (double) resultPtr->internalRep.longValue; -#endif - } else { - Tcl_SetResult(interp, - "expression didn't have numeric value", TCL_STATIC); - result = TCL_ERROR; - } - 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); - } + result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); /* discard the expression object */ - } else { - /* - * An empty string. Just set the result double to 0.0. - */ - - *ptr = 0.0; } return result; } @@ -4357,21 +4264,27 @@ Tcl_ExprLongObj(interp, objPtr, ptr) { Tcl_Obj *resultPtr; int result; + double d; result = Tcl_ExprObj(interp, objPtr, &resultPtr); - if (result == TCL_OK) { - if (resultPtr->typePtr == &tclIntType) { - *ptr = resultPtr->internalRep.longValue; - } else if (resultPtr->typePtr == &tclDoubleType) { - *ptr = (long) resultPtr->internalRep.doubleValue; + if (result != TCL_OK) { + return TCL_ERROR; + } + /* TODO - This could use a Tcl_GetNumberFromObj */ + if (Tcl_GetDoubleFromObj(interp, resultPtr, &d) != TCL_OK) { + result = TCL_ERROR; + } else if (resultPtr->typePtr == &tclDoubleType) { + if (d < -(double) ULONG_MAX || d > (double) ULONG_MAX ) { + Tcl_SetResult(interp, "integer value too large to represent", + TCL_STATIC); + result = TCL_ERROR; } else { - result = Tcl_GetLongFromObj(interp, resultPtr, ptr); - if (result != TCL_OK) { - return result; - } + *ptr = (long)d; } - Tcl_DecrRefCount(resultPtr); /* discard the result object */ + } else { + result = Tcl_GetLongFromObj(interp, resultPtr, ptr); } + Tcl_DecrRefCount(resultPtr); /* discard the result object */ return result; } @@ -4387,16 +4300,7 @@ Tcl_ExprDoubleObj(interp, objPtr, ptr) result = Tcl_ExprObj(interp, objPtr, &resultPtr); if (result == TCL_OK) { - if (resultPtr->typePtr == &tclIntType) { - *ptr = (double) resultPtr->internalRep.longValue; - } else if (resultPtr->typePtr == &tclDoubleType) { - *ptr = resultPtr->internalRep.doubleValue; - } else { - result = Tcl_GetDoubleFromObj(interp, resultPtr, ptr); - if (result != TCL_OK) { - return result; - } - } + result = Tcl_GetDoubleFromObj( interp, resultPtr, ptr ); Tcl_DecrRefCount(resultPtr); /* discard the result object */ } return result; @@ -5129,6 +5033,8 @@ ExprAbsFunc(clientData, interp, objc, objv) Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); return TCL_OK; } + Tcl_Panic("in ExprAbsFunc: unknown numeric type."); + return TCL_ERROR; /* lint */ } static int diff --git a/generic/tclTest.c b/generic/tclTest.c index 17d85da..d89a14f 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.86.2.4 2005/07/12 20:36:59 kennykb Exp $ + * RCS: @(#) $Id: tclTest.c,v 1.86.2.5 2005/08/17 19:12:10 kennykb Exp $ */ #define TCL_TEST @@ -244,6 +244,14 @@ static int TestexithandlerCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); static int TestexprlongCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int argc, CONST char **argv)); +static int TestexprlongobjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); +static int TestexprdoubleCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int argc, CONST char **argv)); +static int TestexprdoubleobjCmd _ANSI_ARGS_((ClientData dummy, + Tcl_Interp *interp, int objc, + Tcl_Obj *CONST objv[])); static int TestexprparserObjCmd _ANSI_ARGS_((ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); @@ -626,6 +634,12 @@ Tcltest_Init(interp) (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testexprlong", TestexprlongCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testexprlongobj", TestexprlongobjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateCommand(interp, "testexprdouble", TestexprdoubleCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); + Tcl_CreateObjCommand(interp, "testexprdoubleobj", TestexprdoubleobjCmd, + (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateObjCommand(interp, "testexprparser", TestexprparserObjCmd, (ClientData) 0, (Tcl_CmdDeleteProc *) NULL); Tcl_CreateCommand(interp, "testexprstring", TestexprstringCmd, @@ -2301,6 +2315,135 @@ TestexprlongCmd(clientData, interp, argc, argv) /* *---------------------------------------------------------------------- * + * TestexprlongobjCmd -- + * + * This procedure verifies that Tcl_ExprLongObj does not modify the + * interpreter result if there is no error. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestexprlongobjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST *objv; /* Argument objects. */ +{ + long exprResult; + char buf[4 + TCL_INTEGER_SPACE]; + int result; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "expression"); + return TCL_ERROR; + } + Tcl_SetResult(interp, "This is a result", TCL_STATIC); + result = Tcl_ExprLongObj(interp, objv[1], &exprResult); + if (result != TCL_OK) { + return result; + } + sprintf(buf, ": %ld", exprResult); + Tcl_AppendResult(interp, buf, NULL); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestexprdoubleCmd -- + * + * This procedure verifies that Tcl_ExprDouble does not modify the + * interpreter result if there is no error. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestexprdoubleCmd(clientData, interp, argc, argv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int argc; /* Number of arguments. */ + CONST char **argv; /* Argument strings. */ +{ + double exprResult; + char buf[4 + TCL_DOUBLE_SPACE]; + int result; + + if (argc != 2) { + Tcl_AppendResult(interp, "wrong # arguments: should be \"", argv[0], + " expression\"", (char *) NULL); + return TCL_ERROR; + } + Tcl_SetResult(interp, "This is a result", TCL_STATIC); + result = Tcl_ExprDouble(interp, argv[1], &exprResult); + if (result != TCL_OK) { + return result; + } + strcpy(buf, ": "); + Tcl_PrintDouble(interp, exprResult, buf+2); + Tcl_AppendResult(interp, buf, NULL); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * + * TestexprdoubleobjCmd -- + * + * This procedure verifies that Tcl_ExprLongObj does not modify the + * interpreter result if there is no error. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *---------------------------------------------------------------------- + */ + +static int +TestexprdoubleobjCmd(clientData, interp, objc, objv) + ClientData clientData; /* Not used. */ + Tcl_Interp *interp; /* Current interpreter. */ + int objc; /* Number of arguments. */ + Tcl_Obj *CONST *objv; /* Argument objects. */ +{ + double exprResult; + char buf[4 + TCL_DOUBLE_SPACE]; + int result; + + if (objc != 2) { + Tcl_WrongNumArgs(interp, 1, objv, "expression"); + return TCL_ERROR; + } + Tcl_SetResult(interp, "This is a result", TCL_STATIC); + result = Tcl_ExprDoubleObj(interp, objv[1], &exprResult); + if (result != TCL_OK) { + return result; + } + strcpy(buf, ": "); + Tcl_PrintDouble(interp, exprResult, buf+2); + Tcl_AppendResult(interp, buf, NULL); + return TCL_OK; +} + +/* + *---------------------------------------------------------------------- + * * TestexprstringCmd -- * * This procedure tests the basic operation of Tcl_ExprString. diff --git a/tests/expr-old.test b/tests/expr-old.test index 9c3ed56..0c8fb86 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.22.2.6 2005/08/02 18:16:24 dgp Exp $ +# RCS: @(#) $Id: expr-old.test,v 1.22.2.7 2005/08/17 19:12:10 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -1018,6 +1018,7 @@ test expr-old-36.16 {ExprLooksLikeInt procedure} { } {1 {can't use integer value too large to represent as operand of "+"}} testConstraint testexprlong [llength [info commands testexprlong]] +testConstraint testexprdouble [llength [info commands testexprdouble]] testConstraint testexprstring [llength [info commands testexprstring]] test expr-old-37.1 {Check that Tcl_ExprLong doesn't modify interpreter result if no error} testexprlong { @@ -1028,6 +1029,92 @@ test expr-old-37.2 {Tcl_ExprLong handles wide ints gracefully} testexprlong { testexprlong wide(1)+2 } {This is a result: 3} +test expr-old-37.3 {Tcl_ExprLong on the empty string} { + testexprlong "" +} {This is a result: 0} +test expr-old-37.4 {Tcl_ExprLong coerces doubles} { + testexprlong 3+.14159 +} {This is a result: 3} +test expr-old-37.5 {Tcl_ExprLong handles overflows} { + testexprlong 0x80000000 +} {This is a result: -2147483648} +test expr-old-37.6 {Tcl_ExprLong handles overflows} { + testexprlong 0xffffffff +} {This is a result: -1} +test expr-old-37.7 {Tcl_ExprLong handles overflows} \ + -match glob \ + -body { + list [catch {testexprlong 0x100000000} result] $result + } \ + -result {1 {integer value too large to represent*}} +test expr-old-37.8 {Tcl_ExprLong handles overflows} { + testexprlong -0x80000000 +} {This is a result: -2147483648} +test expr-old-37.9 {Tcl_ExprLong handles overflows} { + testexprlong -0xffffffff +} {This is a result: 1} +test expr-old-37.10 {Tcl_ExprLong handles overflows} \ + -match glob \ + -body { + list [catch {testexprlong -0x100000000} result] $result + } \ + -result {1 {integer value too large to represent*}} +test expr-old-37.11 {Tcl_ExprLong handles overflows} testexprlong { + testexprlong 2147483648. +} {This is a result: -2147483648} +test expr-old-37.12 {Tcl_ExprLong handles overflows} testexprlong { + testexprlong 4294967295. +} {This is a result: -1} +test expr-old-37.13 {Tcl_ExprLong handles overflows} \ + -constraints testexprlong \ + -match glob \ + -body { + list [catch {testexprlong 4294967296.} result] $result + } \ + -result {1 {integer value too large to represent*}} +test expr-old-37.14 {Tcl_ExprLong handles overflows} testexprlong { + testexprlong -2147483648. +} {This is a result: -2147483648} +test expr-old-37.15 {Tcl_ExprLong handles overflows} testexprlong { + testexprlong -4294967295. +} {This is a result: 1} +test expr-old-37.16 {Tcl_ExprLong handles overflows} \ + -constraints testexprlong \ + -match glob \ + -body { + list [catch {testexprlong 4294967296.} result] $result + } \ + -result {1 {integer value too large to represent*}} + +test expr-old-37.17 {Check that Tcl_ExprDouble doesn't modify interpreter result if no error} testexprdouble { + testexprdouble 4.+1. +} {This is a result: 5.0} +#Check for [Bug 1109484] +test expr-old-37.18 {Tcl_ExprDouble on the empty string} { + testexprdouble "" +} {This is a result: 0.0} +test expr-old-37.19 {Tcl_ExprDouble coerces wides} { + testexprdouble 1[string repeat 0 17] +} {This is a result: 1e+17} +test expr-old-37.20 {Tcl_ExprDouble coerces bignums} { + testexprdouble 1[string repeat 0 38] +} {This is a result: 1e+38} +test expr-old-37.21 {Tcl_ExprDouble handles overflows} { + testexprdouble 17976931348623157[string repeat 0 292]. +} {This is a result: 1.7976931348623157e+308} +test expr-old-37.22 {Tcl_ExprDouble handles overflows that look like int} { + testexprdouble 17976931348623157[string repeat 0 292] +} {This is a result: 1.7976931348623157e+308} +test expr-old-37.23 {Tcl_ExprDouble handles overflows} { + testexprdouble 17976931348623165[string repeat 0 292]. +} {This is a result: Inf} +test expr-old-37.22 {Tcl_ExprDouble handles overflows that look like int} { + testexprdouble 17976931348623165[string repeat 0 292] +} {This is a result: Inf} +test expr-old-37.23 {Tcl_ExprDouble and NaN} { + list [catch {testexprdouble 0.0/0.0} result] $result +} {1 {floating point value is Not a Number}} + 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 @@ -1067,3 +1154,7 @@ if {(4195835.0 - (4195835.0/3145727.0)*3145727.0) == 256.0} { # cleanup ::tcltest::cleanupTests return + +# Local Variables: +# mode: tcl +# End:
\ No newline at end of file diff --git a/tests/expr.test b/tests/expr.test index d082e31..e14a797 100644 --- a/tests/expr.test +++ b/tests/expr.test @@ -10,7 +10,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.test,v 1.30.2.12 2005/08/15 18:14:01 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.30.2.13 2005/08/17 19:12:10 kennykb Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -6458,6 +6458,113 @@ test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { expr {abs(-2147483648)} } 2147483648 +testConstraint testexprlongobj [llength [info commands testexprlongobj]] +testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] + +test expr-39.1 {Check that Tcl_ExprLongObj doesn't modify interpreter result if no error} testexprlongobj { + testexprlongobj 4+1 +} {This is a result: 5} +#Check for [Bug 1109484] +test expr-39.2 {Tcl_ExprLongObj handles wide ints gracefully} testexprlongobj { + testexprlongobj wide(1)+2 +} {This is a result: 3} + +test expr-39.3 {Tcl_ExprLongObj on the empty string} \ + -constraints testexprlongobj \ + -body { + list [catch {testexprlongobj ""} result] $result + } \ + -match glob \ + -result {1 {syntax error*}} +test expr-39.4 {Tcl_ExprLongObj coerces doubles} testexprlongobj { + testexprlongobj 3+.14159 +} {This is a result: 3} +test expr-39.5 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj 0x80000000 +} {This is a result: -2147483648} +test expr-39.6 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj 0xffffffff +} {This is a result: -1} +test expr-39.7 {Tcl_ExprLongObj handles overflows} \ + -constraints testexprlongobj \ + -match glob \ + -body { + list [catch {testexprlongobj 0x100000000} result] $result + } \ + -result {1 {integer value too large to represent*}} +test expr-39.8 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj -0x80000000 +} {This is a result: -2147483648} +test expr-39.9 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj -0xffffffff +} {This is a result: 1} +test expr-39.10 {Tcl_ExprLongObj handles overflows} \ + -constraints testexprlongobj \ + -match glob \ + -body { + list [catch {testexprlongobj -0x100000000} result] $result + } \ + -result {1 {integer value too large to represent*}} +test expr-39.11 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj 2147483648. +} {This is a result: -2147483648} +test expr-39.12 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj 4294967295. +} {This is a result: -1} +test expr-39.13 {Tcl_ExprLongObj handles overflows} \ + -constraints testexprlongobj \ + -match glob \ + -body { + list [catch {testexprlongobj 4294967296.} result] $result + } \ + -result {1 {integer value too large to represent*}} +test expr-39.14 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj -2147483648. +} {This is a result: -2147483648} +test expr-39.15 {Tcl_ExprLongObj handles overflows} testexprlongobj { + testexprlongobj -4294967295. +} {This is a result: 1} +test expr-39.16 {Tcl_ExprLongObj handles overflows} \ + -constraints testexprlongobj \ + -match glob \ + -body { + list [catch {testexprlongobj 4294967296.} result] $result + } \ + -result {1 {integer value too large to represent*}} + +test expr-39.17 {Check that Tcl_ExprDoubleObj doesn't modify interpreter result if no error} testexprdoubleobj { + testexprdoubleobj 4.+1. +} {This is a result: 5.0} +#Check for [Bug 1109484] +test expr-39.18 {Tcl_ExprDoubleObj on the empty string} \ + -constraints testexprdoubleobj \ + -match glob \ + -body { + list [catch {testexprdoubleobj ""} result] $result + } \ + -result {1 {syntax error*}} +test expr-39.19 {Tcl_ExprDoubleObj coerces wides} testexprdoubleobj { + testexprdoubleobj 1[string repeat 0 17] +} {This is a result: 1e+17} +test expr-39.20 {Tcl_ExprDoubleObj coerces bignums} testexprdoubleobj { + testexprdoubleobj 1[string repeat 0 38] +} {This is a result: 1e+38} +test expr-39.21 {Tcl_ExprDoubleObj handles overflows} testexprdoubleobj { + testexprdoubleobj 17976931348623157[string repeat 0 292]. +} {This is a result: 1.7976931348623157e+308} +test expr-39.22 {Tcl_ExprDoubleObj handles overflows that look like int} testexprdoubleobj { + testexprdoubleobj 17976931348623157[string repeat 0 292] +} {This is a result: 1.7976931348623157e+308} +test expr-39.23 {Tcl_ExprDoubleObj handles overflows} testexprdoubleobj { + testexprdoubleobj 17976931348623165[string repeat 0 292]. +} {This is a result: Inf} +test expr-39.22 {Tcl_ExprDoubleObj handles overflows that look like int} testexprdoubleobj { + testexprdoubleobj 17976931348623165[string repeat 0 292] +} {This is a result: Inf} +test expr-39.23 {Tcl_ExprDoubleObj and NaN} testexprdoubleobj { + list [catch {testexprdoubleobj 0.0/0.0} result] $result +} {1 {floating point value is Not a Number}} + # cleanup if {[info exists a]} { unset a |