From eed7d81a6e748db77c5751d36ac023a6b95fec8b Mon Sep 17 00:00:00 2001 From: nijtmans Date: Sun, 21 Feb 2010 20:27:49 +0000 Subject: Fix [Bug 2954959] expr abs(0.0) is -0.0 and added test cases for it. --- ChangeLog | 5 +++++ generic/tclBasic.c | 60 +++++++++++++++++++++++++++++++++++++----------------- tests/expr.test | 20 +++++++++++++++++- 3 files changed, 65 insertions(+), 20 deletions(-) diff --git a/ChangeLog b/ChangeLog index e34da81..7a9fbae 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2010-02-21 Jan Nijtmans + + * generic/tclBasic.c: Fix [Bug 2954959] expr abs(0.0) is -0.0 + * tests/expr.test + 2010-02-19 Stuart Cassoff * tcl.m4: Correct compiler/linker flags diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 50f1a3d..cf38893 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.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: tclBasic.c,v 1.295.2.16 2009/11/10 20:19:02 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.295.2.17 2010/02/21 20:27:49 nijtmans Exp $ */ #include "tclInt.h" @@ -6463,40 +6463,61 @@ ExprAbsFunc( if (type == TCL_NUMBER_LONG) { long l = *((const long *) ptr); - if (l <= (long)0) { - if (l == LONG_MIN) { - TclBNInitBignumFromLong(&big, l); - goto tooLarge; + + if (l > (long)0) { + goto unChanged; + } else if (l == (long)0) { + const char *string = objv[1]->bytes; + if (!string) { + /* There is no string representation, so internal one is correct */ + goto unChanged; } - Tcl_SetObjResult(interp, Tcl_NewLongObj(-l)); - } else { - Tcl_SetObjResult(interp, objv[1]); + while (isspace(UCHAR(*string))) { + ++string; + } + if (*string != '-') { + goto unChanged; + } + } else if (l == LONG_MIN) { + TclBNInitBignumFromLong(&big, l); + goto tooLarge; } + Tcl_SetObjResult(interp, Tcl_NewLongObj(-l)); return TCL_OK; } if (type == TCL_NUMBER_DOUBLE) { double d = *((const double *) ptr); - if (d <= 0.0) { - Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); + static const double poszero = 0.0; + + /* We need to distinguish here between positive 0.0 and + * negative -0.0, see Bug ID #2954959. + */ + if (d == -0.0) { + if (!memcmp(&d, &poszero, sizeof(double))) { + goto unChanged; + } } else { - Tcl_SetObjResult(interp, objv[1]); + if (d > -0.0) { + goto unChanged; + } } + Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d)); return TCL_OK; } #ifndef NO_WIDE_TYPE if (type == TCL_NUMBER_WIDE) { Tcl_WideInt w = *((const Tcl_WideInt *) ptr); - if (w < (Tcl_WideInt)0) { - if (w == LLONG_MIN) { - TclBNInitBignumFromWideInt(&big, w); - goto tooLarge; - } - Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w)); - } else { - Tcl_SetObjResult(interp, objv[1]); + + if (w >= (Tcl_WideInt)0) { + goto unChanged; + } + if (w == LLONG_MIN) { + TclBNInitBignumFromWideInt(&big, w); + goto tooLarge; } + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(-w)); return TCL_OK; } #endif @@ -6509,6 +6530,7 @@ ExprAbsFunc( mp_neg(&big, &big); Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big)); } else { + unChanged: Tcl_SetObjResult(interp, objv[1]); } return TCL_OK; diff --git a/tests/expr.test b/tests/expr.test index f1054ef..bd6d2b4 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.72.2.3 2009/06/01 21:32:53 dgp Exp $ +# RCS: @(#) $Id: expr.test,v 1.72.2.4 2010/02/21 20:27:50 nijtmans Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -6688,6 +6688,24 @@ test expr-38.6 {abs and -0 [Bug 1893815]} { test expr-38.7 {abs and -0 [Bug 1893815]} { ::tcl::mathfunc::abs -1e-324 } 0.0 +test expr-38.8 {abs and 0.0 [Bug 2954959]} { + ::tcl::mathfunc::abs 0.0 +} 0.0 +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 +test expr-38.11 {abs and 0x0 [Bug 2954959]} { + ::tcl::mathfunc::abs { 0x0} +} { 0x0} +test expr-38.12 {abs and -0x0 [Bug 2954959]} { + ::tcl::mathfunc::abs { -0x0} +} 0 +test expr-38.13 {abs and 0.0 [Bug 2954959]} { + ::tcl::mathfunc::abs 1e-324 +} 1e-324 testConstraint testexprlongobj [llength [info commands testexprlongobj]] testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]] -- cgit v0.12