[kennykb_numerics_branch]

        * generic/tclInt.h:     New ACCEPT_NAN macro to mark code that supports
        * generic/tclCmdAH.c:   or disables accepting of the NaN value at
        * generic/tclExecute.c: various points.
        * generic/tclLink.c:

        * generic/tclStrToD.c:  Bug fix.  Parsing of +/- Infinity was reversed.

        * generic/tclBasic:     Added [expr {entier(.)}].  Rewrote int(.)
        and wide(.) to use the same guts, accepting all non-Inf doubles as
        arguments.

        * generic/tclInt.h:     New routine TclInitBignumFromDouble.
        * generic/tclStrToD.c:  Modified to return code and write error message.

7 files changed, 80 insertions, 74 deletions

diff --git a/ChangeLog b/ChangeLog
index 5975631..6caff3f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,12 +2,21 @@
 
 	[kennykb_numerics_branch]
 
+	* generic/tclInt.h:	New ACCEPT_NAN macro to mark code that supports
+	* generic/tclCmdAH.c:	or disables accepting of the NaN value at 
+	* generic/tclExecute.c:	various points.
+	* generic/tclLink.c:
+
+	* generic/tclStrToD.c:	Bug fix.  Parsing of +/- Infinity was reversed.
+
 	* generic/tclTestObj.c:	Disabled unused [testconvertobj] command.
 
-	* generic/tclBasic:	Added [expr {entier(.)}].
+	* generic/tclBasic:	Added [expr {entier(.)}].  Rewrote int(.)
+	and wide(.) to use the same guts, accepting all non-Inf doubles as
+	arguments.
 
 	* generic/tclInt.h:	New routine TclInitBignumFromDouble.
-	* generic/tclStrToD.c:
+	* generic/tclStrToD.c:	Modified to return code and write error message.
 
 	* generic/tclInt.h:	TCL_WIDE_INT_IS_LONG implies NO_WIDE_TYPE.
 	* generic/tclObj.c:	Removed now unnecessary tests of the
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 7feb1e5..43eb53d 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -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: tclBasic.c,v 1.136.2.22 2005/08/22 15:48:26 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.136.2.23 2005/08/22 20:50:25 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -5189,7 +5189,9 @@ ExprEntierFunc(clientData, interp, objc, objv)
 	/* Non-numeric argument */
 	return TCL_ERROR;
     }
-    TclInitBignumFromDouble(d, &big);
+    if (TclInitBignumFromDouble(interp, d, &big) != TCL_OK) {
+	return TCL_ERROR;
+    }
     Tcl_SetObjResult(interp, Tcl_NewBignumObj(&big));
     return TCL_OK;
 }
@@ -5203,7 +5205,7 @@ ExprIntFunc(clientData, interp, objc, objv)
     Tcl_Obj *CONST *objv;	/* Actual parameter vector */
 {
     long iResult;
-    double d;
+    Tcl_Obj *objPtr;
 #if 0
     register Tcl_Obj *valuePtr;
     Tcl_Obj* oResult;
@@ -5245,37 +5247,19 @@ ExprIntFunc(clientData, interp, objc, objv)
     }
     return TCL_ERROR;
 #else
-    if (objc != 2) {
-	MathFuncWrongNumArgs(interp, 2, objc, objv);
-	return TCL_ERROR;
-    }
-    if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
-	/* Non-numeric argument */
+    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if (Tcl_GetLongFromObj(NULL, objv[1], &iResult) != TCL_OK) {
+    objPtr = Tcl_GetObjResult(interp);
+    if (Tcl_GetLongFromObj(NULL, objPtr, &iResult) != TCL_OK) {
+	/* truncate the bignum; keep only bits in wide int range */
 	mp_int big;
-	if (Tcl_GetBignumFromObj(NULL, objv[1], &big) != TCL_OK) {
-	    /* Argument is really a double; attempt conversion
-	     * For compatibility, impose limitation rules.
-	     * TODO: rethink this? */
-	    if ((d < (double) (long) LONG_MIN)
-		    || (d > (double) (long) LONG_MAX)) {
-		CONST char *s = "integer value too large to represent";
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-		return TCL_ERROR;
-	    }
-	    iResult = (long) d;
-	} else {
-	    /* truncate the bignum; keep only bits in long range */
-	    Tcl_Obj *objPtr;
-	    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
-	    objPtr = Tcl_NewBignumObj(&big);
-	    Tcl_IncrRefCount(objPtr);
-	    Tcl_GetLongFromObj(NULL, objPtr, &iResult);
-	    Tcl_DecrRefCount(objPtr);
-	}
+	Tcl_GetBignumFromObj(NULL, objPtr, &big);
+	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(long), &big);
+	objPtr = Tcl_NewBignumObj(&big);
+	Tcl_IncrRefCount(objPtr);
+	Tcl_GetLongFromObj(NULL, objPtr, &iResult);
+	Tcl_DecrRefCount(objPtr);
     }
     Tcl_SetObjResult(interp, Tcl_NewLongObj(iResult));
     return TCL_OK;
@@ -5291,7 +5275,7 @@ ExprWideFunc(clientData, interp, objc, objv)
     Tcl_Obj *CONST *objv;	/* Actual parameter vector */
 {
     Tcl_WideInt wResult;
-    double d;
+    Tcl_Obj *objPtr;
 #if 0
     register Tcl_Obj *valuePtr;
     Tcl_Obj* oResult;
@@ -5333,37 +5317,19 @@ ExprWideFunc(clientData, interp, objc, objv)
     }
     return TCL_ERROR;
 #else
-    if (objc != 2) {
-	MathFuncWrongNumArgs(interp, 2, objc, objv);
-	return TCL_ERROR;
-    }
-    if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) {
-	/* Non-numeric argument */
+    if (ExprEntierFunc(NULL, interp, objc, objv) != TCL_OK) {
 	return TCL_ERROR;
     }
-    if (Tcl_GetWideIntFromObj(NULL, objv[1], &wResult) != TCL_OK) {
+    objPtr = Tcl_GetObjResult(interp);
+    if (Tcl_GetWideIntFromObj(NULL, objPtr, &wResult) != TCL_OK) {
+	/* truncate the bignum; keep only bits in wide int range */
 	mp_int big;
-	if (Tcl_GetBignumFromObj(NULL, objv[1], &big) != TCL_OK) {
-	    /* Argument is really a double; attempt conversion
-	     * For compatibility, impose limitation rules.
-	     * TODO: rethink this? */
-	    if ((d < Tcl_WideAsDouble(LLONG_MIN))
-		    || (d > Tcl_WideAsDouble(LLONG_MAX))) {
-		CONST char *s = "integer value too large to represent";
-		Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
-		Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
-		return TCL_ERROR;
-	    }
-	    wResult = (Tcl_WideInt) d;
-	} else {
-	    /* truncate the bignum; keep only bits in wide int range */
-	    Tcl_Obj *objPtr;
-	    mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
-	    objPtr = Tcl_NewBignumObj(&big);
-	    Tcl_IncrRefCount(objPtr);
-	    Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
-	    Tcl_DecrRefCount(objPtr);
-	}
+	Tcl_GetBignumFromObj(NULL, objPtr, &big);
+	mp_mod_2d(&big, (int) CHAR_BIT * sizeof(Tcl_WideInt), &big);
+	objPtr = Tcl_NewBignumObj(&big);
+	Tcl_IncrRefCount(objPtr);
+	Tcl_GetWideIntFromObj(NULL, objPtr, &wResult);
+	Tcl_DecrRefCount(objPtr);
     }
     Tcl_SetObjResult(interp, Tcl_NewWideIntObj(wResult));
     return TCL_OK;
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index f837892..dbec394 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.5 2005/08/02 18:15:12 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.57.2.6 2005/08/22 20:50:25 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -2294,6 +2294,7 @@ Tcl_FormatObjCmd(dummy, interp, objc, objv)
 	case 'G':
 	    if (Tcl_GetDoubleFromObj(interp,	/* INTL: Tcl source. */
 		    objv[objIndex], &doubleValue) != TCL_OK) {
+		/*TODO: figure out ACCEPT_NAN */
 		goto fmtError;
 	    }
 	    whichValue = DOUBLE_VALUE;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 9f97fdb..e34d780 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.167.2.30 2005/08/22 03:49:39 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.167.2.31 2005/08/22 20:50:25 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -4678,11 +4678,13 @@ TclExecuteByteCode(interp, codePtr)
 	valuePtr = *(tosPtr - 1);
 	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d1);
 	if (result != TCL_OK) {
+#ifdef ACCEPT_NAN
 	    if (valuePtr->typePtr == &tclDoubleType) {
 		/* NaN first argument -> result is also NaN */
 		result = TCL_OK;
 		NEXT_INST_F(1, 1, 0);
 	    }
+#endif
 	    TRACE(("%.20s %.20s => ILLEGAL 1st TYPE %s\n",
 		    O2S(value2Ptr), O2S(valuePtr), 
 		    (valuePtr->typePtr? valuePtr->typePtr->name: "null")));
@@ -4691,12 +4693,14 @@ TclExecuteByteCode(interp, codePtr)
 	}
 	result = Tcl_GetDoubleFromObj(NULL, value2Ptr, &d2);
 	if (result != TCL_OK) {
+#ifdef ACCEPT_NAN
 	    if (value2Ptr->typePtr == &tclDoubleType) {
 		/* NaN second argument -> result is also NaN */
 		objResultPtr = value2Ptr;
 		result = TCL_OK;
 		NEXT_INST_F(1, 2, 1);
 	    }
+#endif
 	    TRACE(("%.20s %.20s => ILLEGAL 2nd TYPE %s\n",
 		    O2S(value2Ptr), O2S(valuePtr), 
 		    (value2Ptr->typePtr? value2Ptr->typePtr->name: "null")));
@@ -5082,6 +5086,7 @@ TclExecuteByteCode(interp, codePtr)
 	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
 	if ((result == TCL_OK) || valuePtr->typePtr == &tclDoubleType) {
 	    /* Value is now numeric (including NaN) */
+#ifdef ACCEPT_NAN
 	    if (result != TCL_OK) {
 	        /* Value is NaN */
 		if (*pc == INST_BITNOT) {
@@ -5091,6 +5096,7 @@ TclExecuteByteCode(interp, codePtr)
 		/* -NaN => NaN */
 		NEXT_INST_F(1, 0, 0);
 	    }
+#endif
 	    if (valuePtr->typePtr == &tclDoubleType) {
 		if (*pc == INST_BITNOT) {
 		    /* ~ arg must be an integer */
@@ -5310,7 +5316,7 @@ TclExecuteByteCode(interp, codePtr)
 	result = Tcl_GetDoubleFromObj(NULL, valuePtr, &d);
 	if ((result == TCL_OK) || valuePtr->typePtr == &tclDoubleType) {
 	    /* Value is now numeric (including NaN) */
-#if 0
+#ifndef ACCEPT_NAN
 	    if ((*pc == INST_TRY_CVT_TO_NUMERIC) && (result != TCL_OK)) {
 		/* Numeric conversion of NaN -> error */
 		CONST char *s = "domain error: argument not in valid range";
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 76e3060..2162650 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -12,13 +12,18 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclInt.h,v 1.202.2.28 2005/08/22 15:48:26 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.202.2.29 2005/08/22 20:50:26 dgp Exp $
  */
 
 #ifndef _TCLINT
 #define _TCLINT
 
+/*
+ * Some numerics configuration options
+ */
+
 #define NO_WIDE_TYPE
+#undef ACCEPT_NAN
 
 /*
  * Common include files needed by most of the Tcl source files are
@@ -2012,8 +2017,8 @@ MODULE_SCOPE Tcl_Obj *	TclIncrObjVar2 _ANSI_ARGS_((Tcl_Interp *interp,
 			    Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr,
 			    Tcl_Obj *incrPtr, int flags));
 MODULE_SCOPE void	TclInitAlloc _ANSI_ARGS_((void));
-MODULE_SCOPE void	TclInitBignumFromDouble _ANSI_ARGS_((double d,
-			    mp_int *b));
+MODULE_SCOPE int	TclInitBignumFromDouble _ANSI_ARGS_((Tcl_Interp *interp,
+			    double d, mp_int *b));
 MODULE_SCOPE void	TclInitDbCkalloc _ANSI_ARGS_((void));
 MODULE_SCOPE void	TclInitDoubleConversion _ANSI_ARGS_((void));
 MODULE_SCOPE void	TclInitEmbeddedConfigurationInformation 
diff --git a/generic/tclLink.c b/generic/tclLink.c
index f8a430d..4b71a35 100644
--- a/generic/tclLink.c
+++ b/generic/tclLink.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclLink.c,v 1.8.6.2 2005/08/02 18:15:59 dgp Exp $
+ * RCS: @(#) $Id: tclLink.c,v 1.8.6.3 2005/08/22 20:50:26 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -341,9 +341,16 @@ LinkTraceProc(clientData, interp, name1, name2, flags)
     case TCL_LINK_DOUBLE:
 	if (Tcl_GetDoubleFromObj(NULL, valueObj, &linkPtr->lastValue.d)
 		!= TCL_OK) {
+#ifdef ACCEPT_NAN
+	  if (valueObj->typePtr != &tclDoubleType) {
+#endif
 	    Tcl_ObjSetVar2(interp, linkPtr->varName, NULL, ObjValue(linkPtr),
 		    TCL_GLOBAL_ONLY);
 	    return "variable must have real value";
+#ifdef ACCEPT_NAN
+	  }
+	  linkPtr->lastValue.d = valueObj->internalRep.doubleValue;
+#endif
 	}
 	*(double *)(linkPtr->addr) = linkPtr->lastValue.d;
 	break;
diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c
index ba14cbd..67f3acb 100755
--- a/generic/tclStrToD.c
+++ b/generic/tclStrToD.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.25 2005/08/22 15:48:26 dgp Exp $
+ * RCS: @(#) $Id: tclStrToD.c,v 1.1.2.26 2005/08/22 20:50:26 dgp Exp $
  *
  *----------------------------------------------------------------------
  */
@@ -992,9 +992,9 @@ TclParseNumber( Tcl_Interp* interp,
 	case sINF:
 	case sINFINITY:
 	    if ( signum ) {
-		objPtr->internalRep.doubleValue = HUGE_VAL;
+		objPtr->internalRep.doubleValue = - HUGE_VAL;
 	    } else {
-		objPtr->internalRep.doubleValue = -HUGE_VAL;
+		objPtr->internalRep.doubleValue = HUGE_VAL;
 	    }
 	    objPtr->typePtr = &tclDoubleType;
 	    break;
@@ -2702,12 +2702,23 @@ TclFinalizeDoubleConversion()
  *----------------------------------------------------------------------
  */
 
-void
-TclInitBignumFromDouble(double d,	/* Number to convert */
+int
+TclInitBignumFromDouble(Tcl_Interp *interp,	/* For error message */
+			double d,	/* Number to convert */
 			mp_int* b)	/* Place to store the result */
 {
     double fract;
     int expt;
+
+    /* Infinite values can't convert to bignum */
+    if ((d > DBL_MAX) || (d < -DBL_MAX)) {
+	if (interp != NULL) {
+	    char *s = "integer value too large to represent";
+	    Tcl_SetObjResult(interp, Tcl_NewStringObj(s, -1));
+	    Tcl_SetErrorCode(interp, "ARITH", "IOVERFLOW", s, NULL);
+	}
+	return TCL_ERROR;
+    }
     fract = frexp(d,&expt);
     if (expt <= 0) {
 	mp_init(b);
@@ -2733,6 +2744,7 @@ TclInitBignumFromDouble(double d,	/* Number to convert */
 	    b->sign = MP_NEG;
 	}
     }
+    return TCL_OK;
 }
 
 /*