summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog5
-rw-r--r--generic/regc_lex.c6
-rw-r--r--generic/regerror.c2
-rw-r--r--generic/tclBasic.c53
-rw-r--r--generic/tclDate.c12
-rw-r--r--generic/tclGetDate.y14
-rw-r--r--generic/tclStubLib.c4
-rw-r--r--tests/expr.test14
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]]