Fix [Bug 2954959] expr abs(0.0) is -0.0

and added test cases for it.

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  <nijtmans@users.sf.net>
+
+	* generic/tclBasic.c:   Fix [Bug 2954959] expr abs(0.0) is -0.0
+	* tests/expr.test
+
 2010-02-19  Stuart Cassoff  <stwo@users.sourceforge.net>
 
 	* 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]]