diff options
| author | patthoyts <patthoyts@users.sourceforge.net> | 2008-03-24 02:50:48 (GMT) |
|---|---|---|
| committer | patthoyts <patthoyts@users.sourceforge.net> | 2008-03-24 02:50:48 (GMT) |
| commit | cb63dde6f333ff6e25312730911757c7468acc5a (patch) | |
| tree | 84cc9ac6b874dcc8ece70be3945ccd7823b9b8a1 | |
| parent | a2c0799d3a7e5afbaf5b1e8cc06324c123b57299 (diff) | |
| download | tcl-cb63dde6f333ff6e25312730911757c7468acc5a.zip tcl-cb63dde6f333ff6e25312730911757c7468acc5a.tar.gz tcl-cb63dde6f333ff6e25312730911757c7468acc5a.tar.bz2 | |
bug #1923966 - crash in binary format. Added tests for the above crash condition.
| -rw-r--r-- | ChangeLog | 5 | ||||
| -rw-r--r-- | generic/tclBinary.c | 4 | ||||
| -rw-r--r-- | tests/binary.test | 20 |
3 files changed, 26 insertions, 3 deletions
@@ -1,3 +1,8 @@ +2008-03-24 Pat Thoyts <patthoyts@users.sourceforge.net> + + * generic/tclBinary.c: bug #1923966 - crash in binary format + * tests/binary.test: Added tests for the above crash condition. + 2008-03-21 Donal K. Fellows <dkf@users.sf.net> * doc/switch.n: Clarified documentation in respect of two-argument diff --git a/generic/tclBinary.c b/generic/tclBinary.c index f08964d..2045d0f 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.39 2007/12/13 15:23:15 dgp Exp $ + * RCS: @(#) $Id: tclBinary.c,v 1.40 2008/03/24 02:50:52 patthoyts Exp $ */ #include "tclInt.h" @@ -785,7 +785,7 @@ Tcl_BinaryObjCmd( if (!GetFormatSpec(&format, &cmd, &count, &flags)) { break; } - if ((count == 0) && (cmd != '@')) { + if ((count == 0) && !(cmd == '@' || cmd == 'x')) { arg++; continue; } diff --git a/tests/binary.test b/tests/binary.test index 023cc74..72e8986 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.30 2006/11/29 13:59:32 dgp Exp $ +# RCS: @(#) $Id: binary.test,v 1.31 2008/03/24 02:50:49 patthoyts Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -545,6 +545,24 @@ test binary-15.3 {Tcl_BinaryObjCmd: format} { test binary-15.4 {Tcl_BinaryObjCmd: format} { binary format a*X3x3a* "foo" "z" } \x00\x00\x00z +test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} { + binary format x0s 1 +} \x01\x00 +test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} { + binary format x0ss 1 1 +} \x01\x00\x01\x00 +test binary-15.5 {Tcl_BinaryObjCmd: format - bug #1923966} { + binary format x0s 1 +} \x01\x00 +test binary-15.6 {Tcl_BinaryObjCmd: format - bug #1923966} { + binary format x0ss 1 1 +} \x01\x00\x01\x00 +test binary-15.7 {Tcl_BinaryObjCmd: format - bug #1923966} { + binary format x1s 1 +} \x00\x01\x00 +test binary-15.8 {Tcl_BinaryObjCmd: format - bug #1923966} { + binary format x1ss 1 1 +} \x00\x01\x00\x01\x00 test binary-16.1 {Tcl_BinaryObjCmd: format} { binary format a*X*a "foo" "z" |