summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-09-27 15:44:12 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-09-27 15:44:12 (GMT)
commit44c36899ef2859af28128849cfbbb85c911bbb2f (patch)
tree5f0f89707e324dd57715ae9e0334f366372a802b
parent261a0e33fa4af47700e2bc2e480b19e4dfb446ba (diff)
downloadtcl-44c36899ef2859af28128849cfbbb85c911bbb2f.zip
tcl-44c36899ef2859af28128849cfbbb85c911bbb2f.tar.gz
tcl-44c36899ef2859af28128849cfbbb85c911bbb2f.tar.bz2
Fix [Bug 1116542]
-rw-r--r--ChangeLog6
-rw-r--r--generic/tclBinary.c20
-rw-r--r--tests/binary.test6
3 files changed, 29 insertions, 3 deletions
diff --git a/ChangeLog b/ChangeLog
index bbba41b..f3e3de1 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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