Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.69
diff -u -r1.69 tclBinary.c
--- generic/tclBinary.c	10 Dec 2010 13:08:54 -0000	1.69
+++ generic/tclBinary.c	17 Dec 2010 14:40:03 -0000
@@ -1497,6 +1497,9 @@
 		}
 		valuePtr = ScanNumber(buffer+offset, cmd, flags,
 			&numberCachePtr);
+		if (valuePtr == NULL) {
+		    goto domainError;
+		}
 		offset += size;
 	    } else {
 		if (count == BINARY_ALL) {
@@ -1509,6 +1512,10 @@
 		src = buffer + offset;
 		for (i = 0; i < count; i++) {
 		    elementPtr = ScanNumber(src, cmd, flags, &numberCachePtr);
+		    if (elementPtr == NULL) {
+			goto domainError;
+		    }
+
 		    src += size;
 		    Tcl_ListObjAppendElement(NULL, valuePtr, elementPtr);
 		}
@@ -1580,6 +1587,10 @@
     errorString = "not enough arguments for all format specifiers";
     goto error;
 
+ domainError:
+    errorString = "domain error";
+    goto error;
+
  badField:
     {
 	Tcl_UniChar ch;
@@ -2039,8 +2050,22 @@
 				 * different numbers have been scanned. */
 {
     long value;
-    float fvalue;
-    double dvalue;
+    union {
+	float f;
+	int i;
+    } fvalue;
+    union {
+	double d;
+	struct {
+#ifdef WORDS_BIGENDIAN
+	    int word0;
+	    int word1;
+#else
+	    int word1;
+	    int word0;
+#endif
+	} w;
+    } dvalue;
     Tcl_WideUInt uwvalue;
 
     /*
@@ -2206,8 +2231,15 @@
     case 'f':
     case 'R':
     case 'r':
-	CopyNumber(buffer, &fvalue, sizeof(float), type);
-	return Tcl_NewDoubleObj(fvalue);
+	CopyNumber(buffer, &fvalue.f, sizeof(float), type);
+#if !defined( __hppa)
+	if (TclIsNaN(fvalue.f)) {
+	    if ((fvalue.i & (1 << 22)) == 0) {
+		return NULL;
+	    }
+	}
+#endif
+	return Tcl_NewDoubleObj(fvalue.f);
 
 	/*
 	 * 64-bit IEEE double-precision floating point.
@@ -2216,8 +2248,15 @@
     case 'd':
     case 'Q':
     case 'q':
-	CopyNumber(buffer, &dvalue, sizeof(double), type);
-	return Tcl_NewDoubleObj(dvalue);
+	CopyNumber(buffer, &dvalue.d, sizeof(double), type);
+#if !defined( __hppa)
+	if (TclIsNaN(dvalue.d)) {
+	    if ((dvalue.w.word0 & (1 << 19)) == 0) {
+		return NULL;
+	    }
+	}
+#endif
+	return Tcl_NewDoubleObj(dvalue.d);
     }
     return NULL;
 }
Index: tests/binary.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/binary.test,v
retrieving revision 1.43
diff -u -r1.43 binary.test
--- tests/binary.test	9 Nov 2010 14:20:19 -0000	1.43
+++ tests/binary.test	17 Dec 2010 14:40:03 -0000
@@ -1583,6 +1583,14 @@
     unset -nocomplain arg1
     list [binary scan \xff\xff\xff\xff\xff\xff\xff\xff d arg1] $arg1
 } -match glob -result {1 -NaN*}
+test binary-40.5 {ScanNumber: sNaN} -body {
+    unset -nocomplain arg1
+    binary scan \xff\x9f\x9f\xff f1 arg1
+} -returnCodes 1 -result {domain error}
+test binary-40.6 {ScanNumber: sNaN} -body {
+    unset -nocomplain arg1
+    list [binary scan \xff\xf3\xff\xff\xff\xff\xf3\xff d arg1] $arg1
+} -returnCodes 1 -result {domain error}
 
 test binary-41.1 {ScanNumber: word alignment} {
     unset -nocomplain arg1; unset arg2
@@ -2388,7 +2396,7 @@
     set d
 } -match glob -result NaN*
 test binary-64.2 {NaN} -constraints ieeeFloatingPoint -body {
-    binary scan [binary format w 0x7ff0123456789aBc] q d
+    binary scan [binary format w 0x7ffc123456789aBc] q d
     set d
 } -match glob -result NaN(*123456789abc)
 
