diff options
| -rw-r--r-- | ChangeLog | 9 | ||||
| -rw-r--r-- | generic/tclExecute.c | 21 | ||||
| -rw-r--r-- | generic/tclParseExpr.c | 5 | ||||
| -rw-r--r-- | tests/expr.test | 30 |
4 files changed, 60 insertions, 5 deletions
@@ -1,3 +1,12 @@ +2002-07-22 Donal K. Fellows <fellowsd@cs.man.ac.uk> + + * tests/expr.test (expr-22.*): Added tests to help detect the + corrected handling. + * generic/tclExecute.c (IllegalExprOperandType): Improved error + message generated when attempting to manipulate Inf and NaN values. + * generic/tclParseExpr.c (GetLexeme): Allowed parser to recognise + 'Inf' as a floating-point number. [Bug 218000] + 2002-07-21 Don Porter <dgp@users.sourceforge.net> * tclIOUtil.c: Silence compiler warning. [Bug 584408]. diff --git a/generic/tclExecute.c b/generic/tclExecute.c index b8d1817..c2e467e 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -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: tclExecute.c,v 1.80 2002/07/19 12:31:09 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.81 2002/07/22 10:04:17 dkf Exp $ */ #include "tclInt.h" @@ -3160,7 +3160,7 @@ TclExecuteByteCode(interp, codePtr) if ((t1Ptr == &tclDoubleType) || (t2Ptr == &tclDoubleType)) { /* * Do double arithmetic. - */ + */ doDouble = 1; if (t1Ptr == &tclIntType) { d1 = i; /* promote value 1 to double */ @@ -4457,6 +4457,22 @@ IllegalExprOperandType(interp, pc, opndPtr) int length; s = Tcl_GetStringFromObj(opndPtr, &length); + /* + * strtod() isn't particularly consistent about detecting Inf + * and NaN between platforms. + */ + if (length == 3) { + if ((s[0]=='n' || s[0]=='N') && (s[1]=='a' || s[1]=='A') && + (s[2]=='n' || s[2]=='N')) { + msg = "non-numeric floating-point value"; + goto makeErrorMessage; + } + if ((s[0]=='i' || s[0]=='I') && (s[1]=='n' || s[1]=='N') && + (s[2]=='f' || s[2]=='F')) { + msg = "infinite floating-point value"; + goto makeErrorMessage; + } + } if (TclLooksLikeInt(s, length)) { /* * If something that looks like an integer appears here, then @@ -4482,6 +4498,7 @@ IllegalExprOperandType(interp, pc, opndPtr) msg = "floating-point value"; } } + makeErrorMessage: Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "can't use ", msg, " as operand of \"", operatorStrings[opCode - INST_LOR], "\"", (char *) NULL); diff --git a/generic/tclParseExpr.c b/generic/tclParseExpr.c index 6d1fc30..1c6a5f5 100644 --- a/generic/tclParseExpr.c +++ b/generic/tclParseExpr.c @@ -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: tclParseExpr.c,v 1.13 2002/06/21 21:17:39 jenglish Exp $ + * RCS: @(#) $Id: tclParseExpr.c,v 1.14 2002/07/22 10:04:17 dkf Exp $ */ #include "tclInt.h" @@ -1628,7 +1628,8 @@ GetLexeme(infoPtr) return TCL_OK; } } else if (startsWithDigit || (c == '.') - || (c == 'n') || (c == 'N')) { + || (c == 'i') || (c == 'I') /* Could be 'Inf' */ + || (c == 'n') || (c == 'N')) { /* Could be 'NaN' */ errno = 0; doubleValue = strtod(src, &termPtr); if (termPtr != src) { diff --git a/tests/expr.test b/tests/expr.test index 4e0f18b..90ace83 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.15 2002/07/10 08:25:59 dkf Exp $ +# RCS: @(#) $Id: expr.test,v 1.16 2002/07/22 10:04:17 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -775,6 +775,34 @@ test expr-21.10 {non-numeric boolean literals} {expr !on } 0 test expr-21.11 {non-numeric boolean literals} {expr !no } 1 test expr-21.12 {non-numeric boolean literals} {expr !yes } 0 +# Test for non-numeric float handling +test expr-22.1 {non-numeric floats} { + list [catch {expr {NaN + 1}} msg] $msg +} {1 {domain error: argument not in valid range}} +test expr-22.2 {non-numeric floats} { + list [catch {expr {Inf + 1}} msg] $msg +} {1 {can't use infinite floating-point value as operand of "+"}} +test expr-22.3 {non-numeric floats} { + set nan NaN + list [catch {expr {$nan + 1}} msg] $msg +} {1 {domain error: argument not in valid range}} +test expr-22.4 {non-numeric floats} { + set inf Inf + list [catch {expr {$inf + 1}} msg] $msg +} {1 {can't use infinite floating-point value as operand of "+"}} +test expr-22.5 {non-numeric floats} { + list [catch {expr NaN} msg] $msg +} {1 {domain error: argument not in valid range}} +test expr-22.6 {non-numeric floats} { + list [catch {expr Inf} msg] $msg +} {1 {floating-point value too large to represent}} +test expr-22.7 {non-numeric floats} { + list [catch {expr {1 / NaN}} msg] $msg +} {1 {domain error: argument not in valid range}} +test expr-22.8 {non-numeric floats} knownBug { + list [catch {expr {1 / Inf}} msg] $msg +} {1 {can't use infinite floating-point value as operand of "/"}} + # cleanup if {[info exists a]} { unset a |