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

Some more tests, showing that the LONG implementation
was not quite correct too, and a fix for that.
Some more internal "const" additions

8 files changed, 71 insertions, 39 deletions

diff --git a/ChangeLog b/ChangeLog
index 53ec490..f3fcdc8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,6 +5,11 @@
 
 2010-02-21  Jan Nijtmans  <nijtmans@users.sf.net>
 
+	* generic/tclDate.c     Some more const tables.
+	* generic/tclGetDate.y
+	* generic/regc_lex.c
+	* generic/regerror.c
+	* generic/tclStubLib.c
 	* generic/tclBasic.c:   Fix [Bug 2954959] expr abs(0.0) is -0.0
 	* tests/expr.test
 
diff --git a/generic/regc_lex.c b/generic/regc_lex.c
index 4be02c6..f3a46da 100644
--- a/generic/regc_lex.c
+++ b/generic/regc_lex.c
@@ -742,10 +742,10 @@ lexescape(
     struct vars *v)
 {
     chr c;
-    static chr alert[] = {
+    static const chr alert[] = {
 	CHR('a'), CHR('l'), CHR('e'), CHR('r'), CHR('t')
     };
-    static chr esc[] = {
+    static const chr esc[] = {
 	CHR('E'), CHR('S'), CHR('C')
     };
     const chr *save;
@@ -1135,7 +1135,7 @@ newline(void)
 static const chr *
 ch(void)
 {
-    static chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
+    static const chr chstr[] = { CHR('c'), CHR('h'), CHR('\0') };
 
     return chstr;
 }
diff --git a/generic/regerror.c b/generic/regerror.c
index 49b6f3e..a1a0163 100644
--- a/generic/regerror.c
+++ b/generic/regerror.c
@@ -35,7 +35,7 @@
  * Unknown-error explanation.
  */
 
-static char unk[] = "*** unknown regex error code 0x%x ***";
+static const char unk[] = "*** unknown regex error code 0x%x ***";
 
 /*
  * Struct to map among codes, code names, and explanations.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 527ed81..4001407 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.445 2010/02/21 08:56:19 nijtmans Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.446 2010/02/21 20:09:38 nijtmans Exp $
  */
 
 #include "tclInt.h"
@@ -7419,15 +7419,25 @@ 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;
     }
 
@@ -7438,11 +7448,16 @@ ExprAbsFunc(
 	/* 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));
+	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;
     }
 
@@ -7450,15 +7465,14 @@ ExprAbsFunc(
     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
@@ -7471,6 +7485,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/generic/tclDate.c b/generic/tclDate.c
index 5d4a507..f873e3f 100644
--- a/generic/tclDate.c
+++ b/generic/tclDate.c
@@ -2300,7 +2300,7 @@ MODULE_SCOPE int yynerrs;
  * Month and day table.
  */
 
-static TABLE MonthDayTable[] = {
+static const TABLE MonthDayTable[] = {
     { "january",	tMONTH,	 1 },
     { "february",	tMONTH,	 2 },
     { "march",		tMONTH,	 3 },
@@ -2332,7 +2332,7 @@ static TABLE MonthDayTable[] = {
  * Time units table.
  */
 
-static TABLE UnitsTable[] = {
+static const TABLE UnitsTable[] = {
     { "year",		tMONTH_UNIT,	12 },
     { "month",		tMONTH_UNIT,	 1 },
     { "fortnight",	tDAY_UNIT,	14 },
@@ -2350,7 +2350,7 @@ static TABLE UnitsTable[] = {
  * Assorted relative-time words.
  */
 
-static TABLE OtherTable[] = {
+static const TABLE OtherTable[] = {
     { "tomorrow",	tDAY_UNIT,	1 },
     { "yesterday",	tDAY_UNIT,	-1 },
     { "today",		tDAY_UNIT,	0 },
@@ -2383,7 +2383,7 @@ static TABLE OtherTable[] = {
  * point constants to work around an SGI compiler bug).
  */
 
-static TABLE TimezoneTable[] = {
+static const TABLE TimezoneTable[] = {
     { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
     { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
     { "utc",	tZONE,	   HOUR( 0) },
@@ -2468,7 +2468,7 @@ static TABLE TimezoneTable[] = {
  * Military timezone table.
  */
 
-static TABLE	MilitaryTable[] = {
+static const TABLE MilitaryTable[] = {
     { "a",	tZONE,	-HOUR( 1) },
     { "b",	tZONE,	-HOUR( 2) },
     { "c",	tZONE,	-HOUR( 3) },
@@ -2561,7 +2561,7 @@ LookupWord(
 {
     register char *p;
     register char *q;
-    register TABLE *tp;
+    register const TABLE *tp;
     int i, abbrev;
 
     /*
diff --git a/generic/tclGetDate.y b/generic/tclGetDate.y
index 922b931..c2498b2 100644
--- a/generic/tclGetDate.y
+++ b/generic/tclGetDate.y
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclGetDate.y,v 1.43 2009/11/18 21:59:50 nijtmans Exp $
+ * RCS: @(#) $Id: tclGetDate.y,v 1.44 2010/02/21 20:09:37 nijtmans Exp $
  */
 
 %parse-param {DateInfo* info}
@@ -512,7 +512,7 @@ MODULE_SCOPE int yynerrs;
  * Month and day table.
  */
 
-static TABLE MonthDayTable[] = {
+static const TABLE MonthDayTable[] = {
     { "january",	tMONTH,	 1 },
     { "february",	tMONTH,	 2 },
     { "march",		tMONTH,	 3 },
@@ -544,7 +544,7 @@ static TABLE MonthDayTable[] = {
  * Time units table.
  */
 
-static TABLE UnitsTable[] = {
+static const TABLE UnitsTable[] = {
     { "year",		tMONTH_UNIT,	12 },
     { "month",		tMONTH_UNIT,	 1 },
     { "fortnight",	tDAY_UNIT,	14 },
@@ -562,7 +562,7 @@ static TABLE UnitsTable[] = {
  * Assorted relative-time words.
  */
 
-static TABLE OtherTable[] = {
+static const TABLE OtherTable[] = {
     { "tomorrow",	tDAY_UNIT,	1 },
     { "yesterday",	tDAY_UNIT,	-1 },
     { "today",		tDAY_UNIT,	0 },
@@ -595,7 +595,7 @@ static TABLE OtherTable[] = {
  * point constants to work around an SGI compiler bug).
  */
 
-static TABLE TimezoneTable[] = {
+static const TABLE TimezoneTable[] = {
     { "gmt",	tZONE,	   HOUR( 0) },	    /* Greenwich Mean */
     { "ut",	tZONE,	   HOUR( 0) },	    /* Universal (Coordinated) */
     { "utc",	tZONE,	   HOUR( 0) },
@@ -680,7 +680,7 @@ static TABLE TimezoneTable[] = {
  * Military timezone table.
  */
 
-static TABLE	MilitaryTable[] = {
+static const TABLE MilitaryTable[] = {
     { "a",	tZONE,	-HOUR( 1) },
     { "b",	tZONE,	-HOUR( 2) },
     { "c",	tZONE,	-HOUR( 3) },
@@ -773,7 +773,7 @@ LookupWord(
 {
     register char *p;
     register char *q;
-    register TABLE *tp;
+    register const TABLE *tp;
     int i, abbrev;
 
     /*
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index 24eef57..b2f39fa 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -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: tclStubLib.c,v 1.29 2008/10/22 20:23:59 nijtmans Exp $
+ * RCS: @(#) $Id: tclStubLib.c,v 1.30 2010/02/21 20:09:38 nijtmans Exp $
  */
 
 /*
@@ -175,7 +175,7 @@ TclTomMathInitializeStubs(
     ClientData pkgClientData = NULL;
     const char *actualVersion =
 	Tcl_PkgRequireEx(interp, packageName, version, exact, &pkgClientData);
-    TclTomMathStubs *stubsPtr = pkgClientData;
+    const TclTomMathStubs *stubsPtr = pkgClientData;
 
     if (actualVersion == NULL) {
 	return NULL;
diff --git a/tests/expr.test b/tests/expr.test
index cbba243..05fc956 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.77 2010/02/21 08:56:19 nijtmans Exp $
+# RCS: @(#) $Id: expr.test,v 1.78 2010/02/21 20:09:38 nijtmans Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -6691,6 +6691,18 @@ test expr-38.8 {abs and 0.0 [Bug 2954959]} {
 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]]