From 5330abf13c39fb141897f214a8e8beaddb51a7f5 Mon Sep 17 00:00:00 2001
From: nijtmans <nijtmans>
Date: Sun, 21 Feb 2010 08:56:19 +0000
Subject: Fix [Bug 2954959] expr abs(0.0) is -0.0 and added test cases for it.

---
 ChangeLog          |  9 +++++++--
 generic/tclBasic.c | 10 +++++++---
 tests/expr.test    |  8 +++++++-
 3 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index 5d01665..5e2df70 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-20  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclCompCmds.c (TclCompileStringLenCmd): Make [string length]
@@ -31,8 +36,8 @@
 
 2010-02-16  Jan Nijtmans  <nijtmans@users.sf.net>
 
-	* generic/tclInt.h: Change order of various struct members, restoring
-	potential binary incompatibility with Tcl 8.5
+	* generic/tclInt.h: Change order of various struct members,
+	fixing potential binary incompatibility with Tcl 8.5
 
 2010-02-16  Donal K. Fellows  <dkf@users.sf.net>
 
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 0a191bb..527ed81 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -16,7 +16,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.444 2010/02/15 22:56:19 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.445 2010/02/21 08:56:19 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -7433,9 +7433,13 @@ ExprAbsFunc(
 
     if (type == TCL_NUMBER_DOUBLE) {
 	double d = *((const double *) ptr);
+	static const double poszero = 0.0;
 
-	if (d <= 0.0) {
-	    Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
+	/* We need to distinguish here between positive 0.0 and
+	 * negative -0.0, see Bug ID #2954959.
+	 */
+	if ((d <= -0.0) && memcmp(&d, &poszero, sizeof(double))) {
+		Tcl_SetObjResult(interp, Tcl_NewDoubleObj(-d));
 	} else {
 	    Tcl_SetObjResult(interp, objv[1]);
 	}
diff --git a/tests/expr.test b/tests/expr.test
index f1612b6..cbba243 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.76 2009/08/12 16:06:44 dgp Exp $
+# RCS: @(#) $Id: expr.test,v 1.77 2010/02/21 08:56:19 nijtmans Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -6685,6 +6685,12 @@ 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
 
 testConstraint testexprlongobj   [llength [info commands testexprlongobj]]
 testConstraint testexprdoubleobj [llength [info commands testexprdoubleobj]]
-- 
cgit v0.12