diff options
| author | nijtmans <nijtmans> | 2010-02-22 23:19:16 (GMT) |
|---|---|---|
| committer | nijtmans <nijtmans> | 2010-02-22 23:19:16 (GMT) |
| commit | bf3967bd2ef27474befb6257b15322b9a9fa7333 (patch) | |
| tree | 7a38a9dfca27a0ed05c6e880898461aaed4c6161 | |
| parent | d58785661f5df34462a865083b64842790ac0263 (diff) | |
| download | tcl-bf3967bd2ef27474befb6257b15322b9a9fa7333.zip tcl-bf3967bd2ef27474befb6257b15322b9a9fa7333.tar.gz tcl-bf3967bd2ef27474befb6257b15322b9a9fa7333.tar.bz2 | |
Fix [Bug 2954959] expr abs(-0.0) is -0.0
Added some test cases, adapted and backported from 8.5
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclExecute.c | 12 | ||||
| -rw-r--r-- | tests/expr.test | 21 |
3 files changed, 35 insertions, 3 deletions
@@ -1,3 +1,8 @@ +2010-02-22 Jan Nijtmans <nijtmans@users.sf.net> + + * generic/tclExecute.c: Fix [Bug 2954959] expr abs(-0.0) is -0.0 + * tests/expr.test Added some test cases, backported from 8.5 + 2010-02-11 Andreas Kupries <andreask@activestate.com> * generic/tclCompile.c: [Bug 2949302]: Fixed leak of support diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 78e823a..401f485 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.94.2.30 2009/08/25 20:59:11 andreas_kupries Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.94.2.31 2010/02/22 23:19:17 nijtmans Exp $ */ #include "tclInt.h" @@ -5374,6 +5374,16 @@ ExprAbsFunc(interp, eePtr, clientData) d = valuePtr->internalRep.doubleValue; if (d < 0.0) { dResult = -d; + } else if (d == -0.0) { + /* We need to distinguish here between positive 0.0 and + * negative -0.0, see Bug ID #2954959. + */ + static const double poszero = 0.0; + if (memcmp(&d, &poszero, sizeof(double))) { + dResult = -d; + } else { + dResult = d; + } } else { dResult = d; } diff --git a/tests/expr.test b/tests/expr.test index 7146914..03bb1bd 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.17.2.12 2006/03/23 16:40:32 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.17.2.13 2010/02/22 23:19:16 nijtmans Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -299,7 +299,10 @@ test expr-8.11 {CompileEqualityExpr: error compiling equality arm} { set msg } {syntax error in expression "2!=x": variable references require preceding $} test expr-8.12 {CompileBitAndExpr: equality expr} {expr {"a"eq"a"}} 1 -test expr-8.13 {CompileBitAndExpr: equality expr} {expr {"\374" eq "ü"}} 1 +test expr-8.13 {CompileBitAndExpr: equality expr} { + set s \u00fc + expr {"\374" eq $s} +} 1 test expr-8.14 {CompileBitAndExpr: equality expr} {expr 3eq2} 0 test expr-8.15 {CompileBitAndExpr: equality expr} {expr 2.0eq2} 0 test expr-8.16 {CompileBitAndExpr: equality expr} {expr 3.2ne2.2} 1 @@ -826,6 +829,20 @@ test expr-24.9 {expr edge cases; shifting} {expr 5>>32} 0 test expr-38.1 {abs of smallest 32-bit integer [Bug 1241572]} {wideIs64bit} { expr {abs(int(-2147483648))} } 2147483648 +test expr-38.2 {abs and -0 [Bug 1893815]} { + expr {abs(-0)} +} 0 +test expr-38.3 {abs and -0 [Bug 1893815]} { + expr {abs(-0.0)} +} 0.0 +# tests 38.4 to 38.8 not backported +test expr-38.9 {abs and 0.0 [Bug 2954959]} { + expr {abs(0.0)} +} 0.0 +test expr-38.10 {abs and -0x0 [Bug 2954959]} { + expr {abs(-0x0)} +} 0 +# tests 38.11 to 38.13 not backported test expr-46.1 {round() rounds to +-infinity} { expr round(0.5) |