diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclBinary.c | 20 | ||||
| -rw-r--r-- | tests/binary.test | 6 |
3 files changed, 29 insertions, 3 deletions
@@ -1,3 +1,9 @@ +2005-09-27 Donal K. Fellows <donal.k.fellows@man.ac.uk> + + * generic/tclBinary.c (FormatNumber): Factorize out copying of + double values to a helper to work around ugly broken compiler + problems. [Bug 1116542] + 2005-09-15 Miguel Sofer <msofer@users.sf.net> * doc/ParseCmd.3: copy/paste fix [Bug 1292427] diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 546a35b..cf83b99 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.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: tclBinary.c,v 1.13.2.2 2003/12/17 18:38:28 das Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.13.2.3 2005/09/27 15:44:13 dkf Exp $ */ #include "tclInt.h" @@ -53,6 +53,8 @@ static void DupByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *srcPtr, Tcl_Obj *copyPtr)); static int FormatNumber _ANSI_ARGS_((Tcl_Interp *interp, int type, Tcl_Obj *src, unsigned char **cursorPtr)); +static void CopyNumber _ANSI_ARGS_((CONST VOID *from, VOID *to, + unsigned int length)); static void FreeByteArrayInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr)); static int GetFormatSpec _ANSI_ARGS_((char **formatPtr, char *cmdPtr, int *countPtr)); @@ -1461,7 +1463,11 @@ FormatNumber(interp, type, src, cursorPtr) return TCL_ERROR; } if (type == 'd') { - memcpy((VOID *) *cursorPtr, (VOID *) &dvalue, sizeof(double)); + /* + * Can't just memcpy() here. [Bug 1116542] + */ + + CopyNumber(&dvalue, *cursorPtr, sizeof(double)); *cursorPtr += sizeof(double); } else { float fvalue; @@ -1538,6 +1544,16 @@ FormatNumber(interp, type, src, cursorPtr) } } +/* Ugly workaround for old and broken compiler! */ +static void +CopyNumber(from, to, length) + CONST VOID *from; + VOID *to; + unsigned int length; +{ + memcpy(to, from, length); +} + /* *---------------------------------------------------------------------- * diff --git a/tests/binary.test b/tests/binary.test index 98eb4fc..f792dd8 100644 --- a/tests/binary.test +++ b/tests/binary.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: binary.test,v 1.11.2.2 2003/12/02 09:31:54 dkf Exp $ +# RCS: @(#) $Id: binary.test,v 1.11.2.3 2005/09/27 15:44:13 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -532,6 +532,10 @@ test binary-14.17 {Tcl_BinaryObjCmd: format} {nonPortable pcOnly} { 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.25] d w + set w +} 1.25 test binary-15.1 {Tcl_BinaryObjCmd: format} { list [catch {binary format ax*a "y" "z"} msg] $msg |