Tcl Source Code

Artifact [37f2977cde]
Login

Artifact 37f2977cde4a8742cbffe5abc64592876f46c29f:

Attachment "1116542.patch" to ticket [1116542fff] added by dgp 2005-02-26 05:22:55.
Index: generic/tclBinary.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBinary.c,v
retrieving revision 1.13.2.2
diff -u -r1.13.2.2 tclBinary.c
--- generic/tclBinary.c	17 Dec 2003 18:38:28 -0000	1.13.2.2
+++ generic/tclBinary.c	25 Feb 2005 22:21:29 -0000
@@ -51,6 +51,8 @@
 
 static void		DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr,
 			    Tcl_Obj *copyPtr));
+static void		CopyNumber _ANSI_ARGS_((CONST VOID *from,
+			    VOID *to, unsigned int length));
 static int		FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type,
 			    Tcl_Obj *src, unsigned char **cursorPtr));
 static void		FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
@@ -1437,6 +1439,15 @@
  *----------------------------------------------------------------------
  */
 
+static void
+CopyNumber(from, to, length)
+    CONST VOID *from;
+    VOID *to;
+    unsigned int length;
+{
+    memcpy(to, from, length);
+}
+
 static int
 FormatNumber(interp, type, src, cursorPtr)
     Tcl_Interp *interp;		/* Current interpreter, used to report
@@ -1461,7 +1472,7 @@
 	    return TCL_ERROR;
 	}
 	if (type == 'd') {
-	    memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double));
+	    CopyNumber(&dvalue, *cursorPtr, sizeof(double));
 	    *cursorPtr += sizeof(double);
 	} else {
 	    float fvalue;
Index: tests/binary.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/binary.test,v
retrieving revision 1.11.2.2
diff -u -r1.11.2.2 binary.test
--- tests/binary.test	2 Dec 2003 09:31:54 -0000	1.11.2.2
+++ tests/binary.test	25 Feb 2005 22:21:31 -0000
@@ -532,6 +532,10 @@
     set a {1.6 3.4}
     binary format d1 $a
 } \x9a\x99\x99\x99\x99\x99\xf9\x3f
+test binary-14.18 {FormatNumber: Bug 1116542} {
+    binary scan [binary format d 1.2] d w
+    set w
+} 1.2
 
 test binary-15.1 {Tcl_BinaryObjCmd: format} {
     list [catch {binary format ax*a "y" "z"} msg] $msg