Tcl Source Code

Changes On Branch tip-450
Login
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch tip-450 Excluding Merge-Ins

This is equivalent to a diff from ea2f7a7e33 to d64f86cf33

2019-06-20
19:42
[6bdadfba7d] Stop crash with multi-lappend and failing writes check-in: b1e3c213ae user: dkf tags: core-8-branch
2019-06-19
05:09
merge core-8-branch Leaf check-in: d64f86cf33 user: dkf tags: tip-450
2019-06-17
18:28
merge 8.7 check-in: e0511a8a90 user: dgp tags: core-8-7-a3-rc
18:18
merge 8.7 check-in: 806615c420 user: dgp tags: trunk
18:18
merge 8.6 check-in: ea2f7a7e33 user: dgp tags: core-8-branch
18:00
[8b9854c3d8] Undo regression in [info level 0] after ensemble dispatch. check-in: 215b06343d user: dgp tags: core-8-6-branch
2019-06-16
09:42
TIP 521: Float classification functions check-in: d465e9717d user: dkf tags: core-8-branch
2019-06-15
12:06
merge core-8-branch check-in: cf6909fca7 user: dkf tags: tip-450

Changes to doc/binary.n.

15
16
17
18
19
20
21




22
23
24
25
26
27
28
29
30
31




32
33
34
35
36
37
38
\fBbinary decode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
\fBbinary encode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
\fBbinary format \fIformatString \fR?\fIarg arg ...\fR?
.br
\fBbinary scan \fIstring formatString \fR?\fIvarName varName ...\fR?




.BE
.SH DESCRIPTION
.PP
This command provides facilities for manipulating binary data.  The
subcommand \fBbinary format\fR creates a binary string from normal
Tcl values.  For example, given the values 16 and 22, on a 32-bit
architecture, it might produce an 8-byte binary string consisting of
two 4-byte integers, one for each of the numbers.  The subcommand
\fBbinary scan\fR, does the opposite: it extracts data
from a binary string and returns it as ordinary Tcl string values.




The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert
binary data to or from string encodings such as base64 (used in MIME
messages for example).
.PP
Note that other operations on binary data, such as taking a subsequence of it,
getting its length, or reinterpreting it as a string in some encoding, are
done by other Tcl commands (respectively \fBstring range\fR,






>
>
>
>










>
>
>
>







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
\fBbinary decode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
\fBbinary encode \fIformat\fR ?\fI\-option value ...\fR? \fIdata\fR
.br
\fBbinary format \fIformatString \fR?\fIarg arg ...\fR?
.br
\fBbinary scan \fIstring formatString \fR?\fIvarName varName ...\fR?
.br
.VS "8.7, TIP 450"
\fBbinary set \fIvarName formatString \fR?\fIarg arg ...\fR?
.VE "8.7, TIP 450"
.BE
.SH DESCRIPTION
.PP
This command provides facilities for manipulating binary data.  The
subcommand \fBbinary format\fR creates a binary string from normal
Tcl values.  For example, given the values 16 and 22, on a 32-bit
architecture, it might produce an 8-byte binary string consisting of
two 4-byte integers, one for each of the numbers.  The subcommand
\fBbinary scan\fR, does the opposite: it extracts data
from a binary string and returns it as ordinary Tcl string values.
.VS "8.7, TIP 450"
The subcommand \fBbinary set\fR is similar to \fBbinary format\fR, except that
it updates an existing binary string in a variable.
.VE "8.7, TIP 450"
The \fBbinary encode\fR and \fBbinary decode\fR subcommands convert
binary data to or from string encodings such as base64 (used in MIME
messages for example).
.PP
Note that other operations on binary data, such as taking a subsequence of it,
getting its length, or reinterpreting it as a string in some encoding, are
done by other Tcl commands (respectively \fBstring range\fR,
119
120
121
122
123
124
125
126
127
128
129
130
131







132
133
134
135
136
137
138
139
140
141
142
143
144
145

146
147
148
149
150
151
152
153
.
Instructs the decoder to throw an error if it encounters unexpected whitespace
characters. Otherwise it ignores them.
.PP
Note that neither the encoder nor the decoder handle the header and footer of
the uuencode format.
.RE
.SH "BINARY FORMAT"
.PP
The \fBbinary format\fR command generates a binary string whose layout
is specified by the \fIformatString\fR and whose contents come from
the additional arguments.  The resulting binary value is returned.
.PP







The \fIformatString\fR consists of a sequence of zero or more field
specifiers separated by zero or more spaces.  Each field specifier is
a single type character followed by an optional flag character followed
by an optional numeric \fIcount\fR.
Most field specifiers consume one argument to obtain the value to be
formatted.  The type character specifies how the value is to be
formatted.  The \fIcount\fR typically indicates how many items of the
specified type are taken from the value.  If present, the \fIcount\fR
is a non-negative decimal integer or
.QW \fB*\fR ,
which normally indicates
that all of the items in the value are to be used.  If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated. The flag character

is ignored for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.PP
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE






|





>
>
>
>
>
>
>
|













>
|







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
.
Instructs the decoder to throw an error if it encounters unexpected whitespace
characters. Otherwise it ignores them.
.PP
Note that neither the encoder nor the decoder handle the header and footer of
the uuencode format.
.RE
.SH "BINARY FORMAT AND BINARY SET"
.PP
The \fBbinary format\fR command generates a binary string whose layout
is specified by the \fIformatString\fR and whose contents come from
the additional arguments.  The resulting binary value is returned.
.PP
.VS "8.7, TIP 450"
The \fBbinary set\fR command reads an existing binary string stored in the
variable \fIvarName\fR, modifies it according to the \fIformatString\fR using
the contents from the additional arguments, and writes the result back. The
result of the command is the empty string.
.VE "8.7, TIP 450"
.PP
In both cases, \fIformatString\fR consists of a sequence of zero or more field
specifiers separated by zero or more spaces.  Each field specifier is
a single type character followed by an optional flag character followed
by an optional numeric \fIcount\fR.
Most field specifiers consume one argument to obtain the value to be
formatted.  The type character specifies how the value is to be
formatted.  The \fIcount\fR typically indicates how many items of the
specified type are taken from the value.  If present, the \fIcount\fR
is a non-negative decimal integer or
.QW \fB*\fR ,
which normally indicates
that all of the items in the value are to be used.  If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated. The flag character
.QW \fBu\fR
is ignored for \fBbinary format\fR and \fBbinary set\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.PP
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
bytes are used to pad out the field.  If \fIarg\fR is longer than the
specified length, the extra characters will be ignored.  If
\fIcount\fR is
.QW \fB*\fR ,
then all of the bytes in \fIarg\fR will be
formatted.  If \fIcount\fR is omitted, then one character will be
formatted.  For example, the command:
.RS 
.PP
.CS
\fBbinary format\fR a7a*a alpha bravo charlie
.CE 
.PP
will return a binary string equivalent to:
.PP






|







192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
bytes are used to pad out the field.  If \fIarg\fR is longer than the
specified length, the extra characters will be ignored.  If
\fIcount\fR is
.QW \fB*\fR ,
then all of the bytes in \fIarg\fR will be
formatted.  If \fIcount\fR is omitted, then one character will be
formatted.  For example, the command:
.RS
.PP
.CS
\fBbinary format\fR a7a*a alpha bravo charlie
.CE 
.PP
will return a binary string equivalent to:
.PP
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string.  For
example,
.RS 
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE 
.PP
will return a binary string equivalent to:
.PP






|







398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
\fB\ex03\ex00\exfd\exff\ex02\ex01\fR
.CE
.RE
.IP \fBS\fR 5
This form is the same as \fBs\fR except that it stores one or more
16-bit integers in big-endian byte order in the output string.  For
example,
.RS
.PP
.CS
\fBbinary format\fR S3 {3 -3 258 1}
.CE 
.PP
will return a binary string equivalent to:
.PP
481
482
483
484
485
486
487

488
489
490
491
492
493
494
495
.IP \fBf\fR 5
This form is the same as \fBc\fR except that it stores one or more one
or more single-precision floating point numbers in the machine's native
representation in the output string.  This representation is not
portable across architectures, so it should not be used to communicate
floating point numbers across the network.  The size of a floating
point number may vary across architectures, so the number of bytes

that are generated may vary.  If the value overflows the
machine's native representation, then the value of FLT_MAX
as defined by the system will be used instead.  Because Tcl uses
double-precision floating point numbers internally, there may be some
loss of precision in the conversion to single-precision.  For example,
on a Windows system running on an Intel Pentium processor,
.RS 
.PP






>
|







497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
.IP \fBf\fR 5
This form is the same as \fBc\fR except that it stores one or more one
or more single-precision floating point numbers in the machine's native
representation in the output string.  This representation is not
portable across architectures, so it should not be used to communicate
floating point numbers across the network.  The size of a floating
point number may vary across architectures, so the number of bytes
that are generated may vary, but is 4 on common architectures that implement
IEEE floating point representation.  If the value overflows the
machine's native representation, then the value of FLT_MAX
as defined by the system will be used instead.  Because Tcl uses
double-precision floating point numbers internally, there may be some
loss of precision in the conversion to single-precision.  For example,
on a Windows system running on an Intel Pentium processor,
.RS 
.PP
511
512
513
514
515
516
517
518


519
520
521
522
523
524
525
common, but not universal.)
.IP \fBR\fR 5
This form is the same as \fBr\fR except that it stores the
single-precision floating point numbers in big-endian order.
.IP \fBd\fR 5
This form is the same as \fBf\fR except that it stores one or more one
or more double-precision floating point numbers in the machine's native
representation in the output string.  For example, on a


Windows system running on an Intel Pentium processor,
.RS 
.PP
.CS
\fBbinary format\fR d1 {1.6}
.CE 
.PP






|
>
>







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
common, but not universal.)
.IP \fBR\fR 5
This form is the same as \fBr\fR except that it stores the
single-precision floating point numbers in big-endian order.
.IP \fBd\fR 5
This form is the same as \fBf\fR except that it stores one or more one
or more double-precision floating point numbers in the machine's native
representation in the output string (these are usually 8 bytes wide on
common architectures, i.e., those that use IEEE floating point representation).
For example, on a
Windows system running on an Intel Pentium processor,
.RS 
.PP
.CS
\fBbinary format\fR d1 {1.6}
.CE 
.PP
591
592
593
594
595
596
597












598
599
600
601
602
603
604
.CE 
.PP
will return
.PP
.CS
\fBabfdeghi\e000\e000j\fR
.CE












.RE
.SH "BINARY SCAN"
.PP
The \fBbinary scan\fR command parses fields from a binary string,
returning the number of conversions performed.  \fIString\fR gives the
input bytes to be parsed (one byte per character, and characters not
representable as a byte have their high bits chopped)






>
>
>
>
>
>
>
>
>
>
>
>







610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
.CE 
.PP
will return
.PP
.CS
\fBabfdeghi\e000\e000j\fR
.CE
.PP
will return \fBabfdeghi\e000\e000j\fR, and
.VS "8.7, TIP 450"
.PP
.CS
set x abc
\fBbinary set\fR x [email protected]*c 65 68
.CE
.PP
will update the variable \fIx\fR to \fBAbcD\fR (extending it by one byte from
the value it was before).
.VE "8.7, TIP 450"
.RE
.SH "BINARY SCAN"
.PP
The \fBbinary scan\fR command parses fields from a binary string,
returning the number of conversions performed.  \fIString\fR gives the
input bytes to be parsed (one byte per character, and characters not
representable as a byte have their high bits chopped)
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
which normally indicates that all of the remaining items in the data are to
be used.  If there are not enough bytes left after the current cursor
position to satisfy the current field specifier, then the
corresponding variable is left untouched and \fBbinary scan\fR returns
immediately with the number of variables that were set.  If there are
not enough arguments for all of the fields in the format string that
consume arguments, then an error is generated. The flag character
.QW u
may be given to cause some types to be read as unsigned values. The flag
is accepted for all field types but is ignored for non-integer fields.
.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
scan subcommand: 
.PP






|







652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
which normally indicates that all of the remaining items in the data are to
be used.  If there are not enough bytes left after the current cursor
position to satisfy the current field specifier, then the
corresponding variable is left untouched and \fBbinary scan\fR returns
immediately with the number of variables that were set.  If there are
not enough arguments for all of the fields in the format string that
consume arguments, then an error is generated. The flag character
.QW \fBu\fR
may be given to cause some types to be read as unsigned values. The flag
is accepted for all field types but is ignored for non-integer fields.
.PP
A similar example as with \fBbinary format\fR should explain the
relation between field specifiers and arguments in case of the binary
scan subcommand: 
.PP
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
.CE 
.PP
If you require unsigned values you can include the
.QW u
flag character following
the field type. For example, to read an unsigned short value: 
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR
.CE






|







698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort s1 val; \fI# val == 0xFFFF8000\fR
.CE 
.PP
If you require unsigned values you can include the
.QW \fBu\fR
flag character following
the field type. For example, to read an unsigned short value: 
.PP
.CS
set signShort [\fBbinary format\fR s1 0x8000]
\fBbinary scan\fR $signShort su1 val; \fI# val == 0x00008000\fR
.CE
805
806
807
808
809
810
811
812

813
814
815
816
817
818
819
.CE 
.PP
will return \fB2\fR with \fB7 -122\fR stored in \fIvar1\fR and \fB5\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBcu\fR in place of \fBc\fR.
.RE
.IP \fBs\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers

represented in little-endian byte order, or as unsigned if \fBu\fR is placed
immediately after the \fBs\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
example,






|
>







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
.CE 
.PP
will return \fB2\fR with \fB7 -122\fR stored in \fIvar1\fR and \fB5\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBcu\fR in place of \fBc\fR.
.RE
.IP \fBs\fR 5
The data is interpreted as \fIcount\fR 16-bit signed (or unsigned if \fBsu\fR is
used instead of \fBs\fR) integers
represented in little-endian byte order, or as unsigned if \fBu\fR is placed
immediately after the \fBs\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 16-bit integer will be scanned.  For
example,
837
838
839
840
841
842
843
844

845
846
847
848
849
850
851

852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872

873
874
875
876
877
878
879
880
881
882
883
884
885
886

887
888
889
890
891
892
893

894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913

914
915
916
917
918
919
920
921
922
923
924
925
926
927

928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943

944
945
946
947
948
949
950
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE 
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
The data is interpreted as \fIcount\fR 16-bit signed integers

represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBt\fR.  It is otherwise identical to \fBs\fR and \fBS\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.IP \fBi\fR 5
The data is interpreted as \fIcount\fR 32-bit signed integers

represented in little-endian byte order, or as unsigned if \fBu\fR is placed
immediately after the \fBi\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
example,
.RS 
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE 
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBiu\fR is used in place of \fBi\fR.
.RE
.IP \fBI\fR 5
This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed integers represented in big-endian byte

order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR.  For example,
.RS 
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE 
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5
The data is interpreted as \fIcount\fR 32-bit signed integers

represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBn\fR.  It is otherwise identical to \fBi\fR and \fBI\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.IP \fBw\fR 5
The data is interpreted as \fIcount\fR 64-bit signed integers

represented in little-endian byte order, or as unsigned if \fBu\fR is placed
immediately after the \fBw\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 64-bit integer will be scanned.  For
example,
.RS 
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE 
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed integers represented in big-endian byte

order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR.  For example,
.RS 
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE 
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5
The data is interpreted as \fIcount\fR 64-bit signed integers

represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBm\fR.  It is otherwise identical to \fBw\fR and \fBW\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.IP \fBf\fR 5
The data is interpreted as \fIcount\fR single-precision floating point
numbers in the machine's native representation.  The floating point
numbers are stored in the corresponding variable as a list.  If
\fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in
\fIstring\fR will be scanned.  If \fIcount\fR is omitted, then one
single-precision floating point number will be scanned.  The size of a
floating point number may vary across architectures, so the number of
bytes that are scanned may vary.  If the data does not represent a

valid floating point number, the resulting value is undefined and
compiler dependent.  For example, on a Windows system running on an
Intel Pentium processor,
.RS 
.PP
.CS
\fBbinary scan\fR \ex3f\excc\excc\excd f var1






|
>






|
>




















|
>













|
>






|
>



















|
>













|
>















|
>







869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
\fBbinary scan\fR \ex00\ex05\ex00\ex07\exff\exf0 S2S* var1 var2
.CE 
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBt\fR 5
The data is interpreted as \fIcount\fR 16-bit signed (or unsigned if \fBtu\fR is
used instead of \fBt\fR) integers
represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBt\fR.  It is otherwise identical to \fBs\fR and \fBS\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.IP \fBi\fR 5
The data is interpreted as \fIcount\fR 32-bit signed (or unsigned if \fBiu\fR is
used instead of \fBi\fR) integers
represented in little-endian byte order, or as unsigned if \fBu\fR is placed
immediately after the \fBi\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 32-bit integer will be scanned.  For
example,
.RS 
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str i2i* var1 var2
.CE 
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.  Note that the integers returned are signed unless
\fBiu\fR is used in place of \fBi\fR.
.RE
.IP \fBI\fR 5
This form is the same as \fBI\fR except that the data is interpreted
as \fIcount\fR 32-bit signed (or unsigned if \fBIu\fR is
used instead of \fBI\fR) integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBI\fR.  For example,
.RS 
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str I2I* var1 var2
.CE 
.PP
will return \fB2\fR with \fB5 7\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBn\fR 5
The data is interpreted as \fIcount\fR 32-bit signed (or unsigned if \fBnu\fR is
used instead of \fBn\fR) integers
represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBn\fR.  It is otherwise identical to \fBi\fR and \fBI\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.IP \fBw\fR 5
The data is interpreted as \fIcount\fR 64-bit signed (or unsigned if \fBwu\fR is
used instead of \fBw\fR) integers
represented in little-endian byte order, or as unsigned if \fBu\fR is placed
immediately after the \fBw\fR.  The integers are stored in
the corresponding variable as a list.  If \fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in \fIstring\fR will be scanned.  If
\fIcount\fR is omitted, then one 64-bit integer will be scanned.  For
example,
.RS 
.PP
.CS
set str \ex05\ex00\ex00\ex00\ex07\ex00\ex00\ex00\exf0\exff\exff\exff
\fBbinary scan\fR $str wi* var1 var2
.CE 
.PP
will return \fB2\fR with \fB30064771077\fR stored in \fIvar1\fR and
\fB\-16\fR stored in \fIvar2\fR.
.RE
.IP \fBW\fR 5
This form is the same as \fBw\fR except that the data is interpreted
as \fIcount\fR 64-bit signed (or unsigned if \fBWu\fR is
used instead of \fBw\fR) integers represented in big-endian byte
order, or as unsigned if \fBu\fR is placed
immediately after the \fBW\fR.  For example,
.RS 
.PP
.CS
set str \ex00\ex00\ex00\ex05\ex00\ex00\ex00\ex07\exff\exff\exff\exf0
\fBbinary scan\fR $str WI* var1 var2
.CE 
.PP
will return \fB2\fR with \fB21474836487\fR stored in \fIvar1\fR and \fB\-16\fR
stored in \fIvar2\fR.
.RE
.IP \fBm\fR 5
The data is interpreted as \fIcount\fR 64-bit signed (or unsigned if \fBmu\fR is
used instead of \fBm\fR) integers
represented in the native byte order of the machine running the Tcl
script, or as unsigned if \fBu\fR is placed
immediately after the \fBm\fR.  It is otherwise identical to \fBw\fR and \fBW\fR.
To determine what the native byte order of the machine is, refer to
the \fBbyteOrder\fR element of the \fBtcl_platform\fR array.
.IP \fBf\fR 5
The data is interpreted as \fIcount\fR single-precision floating point
numbers in the machine's native representation.  The floating point
numbers are stored in the corresponding variable as a list.  If
\fIcount\fR is
.QW \fB*\fR ,
then all of the remaining bytes in
\fIstring\fR will be scanned.  If \fIcount\fR is omitted, then one
single-precision floating point number will be scanned.  The size of a
floating point number may vary across architectures, so the number of
bytes that are scanned may vary; on most common architectures (i.e., those
that use IEEE floating point representation) it is 4 bytes wide.  If the data does not represent a
valid floating point number, the resulting value is undefined and
compiler dependent.  For example, on a Windows system running on an
Intel Pentium processor,
.RS 
.PP
.CS
\fBbinary scan\fR \ex3f\excc\excc\excd f var1
962
963
964
965
966
967
968
969

970
971
972
973
974
975
976
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR single-precision floating point number in big-endian
order.  This conversion is not portable to the minority of systems not
using IEEE floating point representations.
.IP \fBd\fR 5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation. For example, on a Windows system

running on an Intel Pentium processor,
.RS 
.PP
.CS
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE 
.PP






|
>







1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR single-precision floating point number in big-endian
order.  This conversion is not portable to the minority of systems not
using IEEE floating point representations.
.IP \fBd\fR 5
This form is the same as \fBf\fR except that the data is interpreted
as \fIcount\fR double-precision floating point numbers in the
machine's native representation (which is 8 bytes wide when IEEE floating
point representation is used; this is the common case). For example, on a Windows system
running on an Intel Pentium processor,
.RS 
.PP
.CS
\fBbinary scan\fR \ex9a\ex99\ex99\ex99\ex99\ex99\exf9\ex3f d var1
.CE 
.PP

Changes to generic/tclBinary.c.

76
77
78
79
80
81
82



83
84
85
86
87
88
89
			    unsigned length, int type);
/* Binary ensemble commands */
static int		BinaryFormatCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryScanCmd(ClientData clientData,
			    Tcl_Interp *interp,



			    int objc, Tcl_Obj *const objv[]);
/* Binary encoding sub-ensemble commands */
static int		BinaryEncodeHex(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryDecodeHex(ClientData clientData,
			    Tcl_Interp *interp,






>
>
>







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
			    unsigned length, int type);
/* Binary ensemble commands */
static int		BinaryFormatCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryScanCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinarySetCmd(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
/* Binary encoding sub-ensemble commands */
static int		BinaryEncodeHex(ClientData clientData,
			    Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		BinaryDecodeHex(ClientData clientData,
			    Tcl_Interp *interp,
137
138
139
140
141
142
143

144
145
146
147
148
149
150
/*
 * How to construct the ensembles.
 */

static const EnsembleImplMap binaryMap[] = {
    { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
    { "scan",   BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 },

    { "encode", NULL, NULL, NULL, NULL, 0 },
    { "decode", NULL, NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap encodeMap[] = {
    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },






>







140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
/*
 * How to construct the ensembles.
 */

static const EnsembleImplMap binaryMap[] = {
    { "format", BinaryFormatCmd, TclCompileBasicMin1ArgCmd, NULL, NULL, 0 },
    { "scan",   BinaryScanCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 },
    { "set",	BinarySetCmd, TclCompileBasicMin2ArgCmd, NULL, NULL, 0 },
    { "encode", NULL, NULL, NULL, NULL, 0 },
    { "decode", NULL, NULL, NULL, NULL, 0 },
    { NULL, NULL, NULL, NULL, NULL, 0 }
};
static const EnsembleImplMap encodeMap[] = {
    { "hex",      BinaryEncodeHex, TclCompileBasic1ArgCmd, NULL, NULL, 0 },
    { "uuencode", BinaryEncodeUu,  NULL, NULL, NULL, 0 },
1341
1342
1343
1344
1345
1346
1347




















































































































































































































































































































































































































































































































































































































1348
1349
1350
1351
1352
1353
1354
	    }
	    break;
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;





















































































































































































































































































































































































































































































































































































































 badValue:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue));
    return TCL_ERROR;







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
	    }
	    break;
	}
    }
    Tcl_SetObjResult(interp, resultPtr);
    return TCL_OK;

 badValue:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue));
    return TCL_ERROR;

 badCount:
    errorString = "missing count for \"@\" field specifier";
    goto error;

 badIndex:
    errorString = "not enough arguments for all format specifiers";
    goto error;

 badField:
    {
	Tcl_UniChar ch = 0;
	char buf[TCL_UTF_MAX + 1] = "";

	TclUtfToUniChar(errorString, &ch);
	buf[Tcl_UniCharToUtf(ch, buf)] = '\0';
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"bad field specifier \"%s\"", buf));
	return TCL_ERROR;
    }

 error:
    Tcl_SetObjResult(interp, Tcl_NewStringObj(errorString, -1));
    return TCL_ERROR;
}

/*
 *----------------------------------------------------------------------
 *
 * BinarySetCmd --
 *
 *	This procedure implements the "binary set" Tcl command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */

static int
BinarySetCmd(
    ClientData ignored,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    int arg;			/* Index of next argument to consume. */
    int value = 0;		/* Current integer value to be packed.
				 * Initialized to avoid compiler warning. */
    char cmd;			/* Current format character. */
    int count;			/* Count associated with current format
				 * character. */
    int flags;			/* Format field flags */
    const char *format;		/* Pointer to current position in format
				 * string. */
    Tcl_Obj *valuePtr;		/* Object holding binary value buffer, which
				 * might be value read from variable, or might
				 * be duplicate or new. */
    int originalLength;		/* Length of the starting value read from the
				 * variable. */
    unsigned char *buffer;	/* Start of result buffer. */
    unsigned char *cursor;	/* Current position within result buffer. */
    unsigned char *maxPos;	/* Greatest position within result buffer that
				 * cursor has visited.*/
    const char *errorString;
    const char *errorValue, *str;
    int offset, size, length, i, argLength;
    const unsigned char *bytes;	/* Working buffer for testing arguments. */
    Tcl_Obj **listv;		/* Used for parsing list arguments. */
    int listc;			/* Used for parsing list arguments. */
    int isFloat;		/* What type of number parsing to use. */
    int type;			/* Used for parsing numbers. */
    ClientData data;		/* Used for parsing numbers. */
    Tcl_WideInt wide;		/* Used for parsing numbers. */
    double dummy;		/* Used for parsing numbers. */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "varName formatString ?arg ...?");
	return TCL_ERROR;
    }

    valuePtr = Tcl_ObjGetVar2(interp, objv[1], NULL, 0);
    if (valuePtr == NULL) {
	originalLength = 0;
    } else {
	(void) Tcl_GetByteArrayFromObj(valuePtr, &originalLength);
    }
    length = originalLength;

    /*
     * To avoid copying the data, we format the string in two passes. The
     * first pass computes the size of the output buffer and checks that the
     * supplied values are legal. The second pass places the formatted data
     * into the buffer.
     */

    format = TclGetString(objv[2]);
    arg = 3;
    offset = 0;
    while (*format != '\0') {
	str = format;
	flags = 0;
	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
	    break;
	}
	isFloat = 0;
	switch (cmd) {
	case 'b':
	case 'B':
	    /*
	     * For string-type specifiers, the count corresponds to the number
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		Tcl_GetByteArrayFromObj(objv[arg], &count);
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    bytes = Tcl_GetByteArrayFromObj(objv[arg], &argLength);
	    if (count > argLength) {
		count = argLength;
	    }
	    for (i = 0 ; i < count; i++) {
		switch (bytes[i]) {
		case '0':
		case '1':
		    break;
		default:
		    errorString = "binary";
		    errorValue = Tcl_GetString(objv[arg]);
		    goto badValue;
		}
	    }
	    arg++;
	    offset += (count + 7) / 8;
	    break;
	case 'h':
	case 'H':
	    /*
	     * For string-type specifiers, the count corresponds to the number
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		Tcl_GetByteArrayFromObj(objv[arg], &count);
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    bytes = Tcl_GetByteArrayFromObj(objv[arg], &argLength);
	    if (count > argLength) {
		count = argLength;
	    }
	    for (i = 0 ; i < count; i++) {
		if (!isxdigit(bytes[i])) {		/* INTL: digit */
		    errorString = "hexadecimal";
		    errorValue = Tcl_GetString(objv[arg]);
		    goto badValue;
		}
	    }
	    arg++;
	    offset += (count + 1) / 2;
	    break;
	case 'a':
	case 'A':
	    /*
	     * For string-type specifiers, the count corresponds to the number
	     * of bytes in a single argument.
	     */

	    if (arg >= objc) {
		goto badIndex;
	    }
	    if (count == BINARY_ALL) {
		Tcl_GetByteArrayFromObj(objv[arg], &count);
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    arg++;
	    offset += count;
	    break;
	case 'c':
	    size = 1;
	    goto doNumbers;
	case 't':
	case 's':
	case 'S':
	    size = 2;
	    goto doNumbers;
	case 'n':
	case 'i':
	case 'I':
	    size = 4;
	    goto doNumbers;
	case 'm':
	case 'w':
	case 'W':
	    size = 8;
	    goto doNumbers;
	case 'r':
	case 'R':
	case 'f':
	    size = sizeof(float);
	    isFloat = 1;
	    goto doNumbers;
	case 'q':
	case 'Q':
	case 'd':
	    size = sizeof(double);
	    isFloat = 1;

	doNumbers:
	    if (arg >= objc) {
		goto badIndex;
	    }

	    /*
	     * For number-type specifiers, the count corresponds to the number
	     * of elements in the list stored in a single argument. If no
	     * count is specified, then the argument is taken as a single
	     * non-list value.
	     */

	    if (count == BINARY_NOCOUNT) {
		if (isFloat) {
		    if (TclGetNumberFromObj(NULL, objv[arg],
			    &data, &type) != TCL_OK) {
			return Tcl_GetDoubleFromObj(interp, objv[arg], &dummy);
		    }
		} else {
		    if (Tcl_GetWideIntFromObj(interp, objv[arg],
			    &wide) != TCL_OK) {
			return TCL_ERROR;
		    }
		}
		count = 1;
	    } else {
		/*
		 * The macro evals its args more than once: avoid arg++
		 */

		if (TclListObjGetElements(interp, objv[arg], &listc,
			&listv) != TCL_OK) {
		    return TCL_ERROR;
		}

		if (count == BINARY_ALL) {
		    count = listc;
		} else if (count > listc) {
		    errorString =
			    "number of elements in list does not match count";
		    goto error;
		}
		for (i = 0; i < count; i++) {
		    if (isFloat) {
			if (TclGetNumberFromObj(NULL, listv[i],
				&data, &type) != TCL_OK) {
			    return Tcl_GetDoubleFromObj(interp, listv[i],
				    &dummy);
			}
		    } else {
			if (Tcl_GetWideIntFromObj(interp, listv[i],
				&wide) != TCL_OK) {
			    return TCL_ERROR;
			}
		    }
		}
	    }
	    arg++;
	    offset += count * size;
	    break;

	case 'x':
	    if (count == BINARY_ALL) {
		errorString = "cannot use \"*\" in format string with \"x\"";
		goto error;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    offset += count;
	    break;
	case 'X':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count > offset) || (count == BINARY_ALL)) {
		count = offset;
	    }
	    if (offset > length) {
		length = offset;
	    }
	    offset -= count;
	    break;
	case '@':
	    if (offset > length) {
		length = offset;
	    }
	    if (count == BINARY_ALL) {
		offset = length;
	    } else if (count == BINARY_NOCOUNT) {
		goto badCount;
	    } else {
		offset = count;
	    }
	    break;
	default:
	    errorString = str;
	    goto badField;
	}
    }
    if (offset > length) {
	length = offset;
    }

    /*
     * Prepare the result object by preallocating the caclulated number of
     * bytes and filling with nulls. Note that if we use an operation that can
     * fail part way through, we must duplicate here even if the object is
     * unshared because we mustn't mutate anything on failure. Bother.
     */

    if (valuePtr == NULL) {
	valuePtr = Tcl_NewObj();
    } else if (Tcl_IsShared(valuePtr)) {
	valuePtr = Tcl_DuplicateObj(valuePtr);
    }
    buffer = Tcl_SetByteArrayLength(valuePtr, length);
    if (length > originalLength) {
	memset(buffer + originalLength, 0, length - originalLength);
    }

    /*
     * Pack the data into the result object. Note that we can skip the error
     * checking during this pass, since we have already parsed the string
     * once.
     */

    arg = 3;
    format = TclGetString(objv[2]);
    cursor = buffer;
    maxPos = cursor + originalLength;
    while (*format != 0) {
	flags = 0;
	if (!GetFormatSpec(&format, &cmd, &count, &flags)) {
	    break;
	}
	if ((count == 0) && (cmd != '@')) {
	    if (cmd != 'x') {
		arg++;
	    }
	    continue;
	}
	switch (cmd) {
	case 'a':
	case 'A': {
	    char pad = (char) (cmd == 'a' ? '\0' : ' ');

	    bytes = Tcl_GetByteArrayFromObj(objv[arg++], &length);

	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if (length >= count) {
		memcpy(cursor, bytes, count);
	    } else {
		memcpy(cursor, bytes, length);
		memset(cursor + length, pad, count - length);
	    }
	    cursor += count;
	    break;
	}
	case 'b':
	case 'B': {
	    unsigned char *last;

	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 7) / 8);
	    if (count > length) {
		count = length;
	    }
	    value = 0;
	    if (cmd == 'B') {
		for (offset = 0; offset < count; offset++) {
		    value <<= 1;
		    if (str[offset] == '1') {
			value |= 1;
		    }
		    if (((offset + 1) % 8) == 0) {
			*cursor++ = UCHAR(value);
			value = 0;
		    }
		}
	    } else {
		for (offset = 0; offset < count; offset++) {
		    value >>= 1;
		    if (str[offset] == '1') {
			value |= 128;
		    }
		    if (!((offset + 1) % 8)) {
			*cursor++ = UCHAR(value);
			value = 0;
		    }
		}
	    }
	    if ((offset % 8) != 0) {
		if (cmd == 'B') {
		    value <<= 8 - (offset % 8);
		} else {
		    value >>= 8 - (offset % 8);
		}
		*cursor++ = UCHAR(value);
	    }
	    while (cursor < last) {
		*cursor++ = '\0';
	    }
	    break;
	}
	case 'h':
	case 'H': {
	    unsigned char *last;
	    int c;

	    str = TclGetStringFromObj(objv[arg], &length);
	    arg++;
	    if (count == BINARY_ALL) {
		count = length;
	    } else if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    last = cursor + ((count + 1) / 2);
	    if (count > length) {
		count = length;
	    }
	    value = 0;
	    if (cmd == 'H') {
		for (offset = 0; offset < count; offset++) {
		    value <<= 4;
		    c = str[offset] - '0';
		    if (c > 9) {
			c += ('0' - 'A') + 10;
		    }
		    if (c > 16) {
			c += ('A' - 'a');
		    }
		    value |= (c & 0xf);
		    if (offset % 2) {
			*cursor++ = (char) value;
			value = 0;
		    }
		}
	    } else {
		for (offset = 0; offset < count; offset++) {
		    value >>= 4;
		    c = str[offset] - '0';
		    if (c > 9) {
			c += ('0' - 'A') + 10;
		    }
		    if (c > 16) {
			c += ('A' - 'a');
		    }
		    value |= ((c << 4) & 0xf0);
		    if (offset % 2) {
			*cursor++ = UCHAR(value & 0xff);
			value = 0;
		    }
		}
	    }
	    if (offset % 2) {
		if (cmd == 'H') {
		    value <<= 4;
		} else {
		    value >>= 4;
		}
		*cursor++ = UCHAR(value);
	    }

	    while (cursor < last) {
		*cursor++ = '\0';
	    }
	    break;
	}
	case 'c':
	case 't':
	case 's':
	case 'S':
	case 'n':
	case 'i':
	case 'I':
	case 'm':
	case 'w':
	case 'W':
	case 'r':
	case 'R':
	case 'd':
	case 'q':
	case 'Q':
	case 'f':
	    if (count == BINARY_NOCOUNT) {
		/*
		 * Note that we are casting away the const-ness of objv, but
		 * this is safe since we aren't going to modify the array.
		 */

		listv = (Tcl_Obj **) (objv + arg);
		listc = 1;
		count = 1;
	    } else {
		TclListObjGetElements(interp, objv[arg], &listc, &listv);
		if (count == BINARY_ALL) {
		    count = listc;
		}
	    }
	    arg++;
	    for (i = 0; i < count; i++) {
		/*
		 * Already checked the error cases.
		 */

		(void) FormatNumber(interp, cmd, listv[i], &cursor);
	    }
	    break;
	case 'x':
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    memset(cursor, 0, count);
	    cursor += count;
	    break;
	case 'X':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_NOCOUNT) {
		count = 1;
	    }
	    if ((count == BINARY_ALL) || (count > cursor - buffer)) {
		cursor = buffer;
	    } else {
		cursor -= count;
	    }
	    break;
	case '@':
	    if (cursor > maxPos) {
		maxPos = cursor;
	    }
	    if (count == BINARY_ALL) {
		cursor = maxPos;
	    } else {
		cursor = buffer + count;
	    }
	    break;
	}
    }

    /*
     * Store the value back in the variable. This is vital if the value was
     * allocated in this function, which could be the case if either we
     * duplicated a shared value or we are assigning the variable anew.
     */

    Tcl_IncrRefCount(valuePtr);
    if (!Tcl_ObjSetVar2(interp, objv[1], NULL, valuePtr, TCL_LEAVE_ERR_MSG)) {
	/*
	 * Failure here with an in-place modification means there are traces
	 * applying shenanigans.
	 */

	TclDecrRefCount(valuePtr);
	return TCL_ERROR;
    }
    TclDecrRefCount(valuePtr);
    return TCL_OK;

 badValue:
    Tcl_ResetResult(interp);
    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
	    "expected %s string but got \"%s\" instead",
	    errorString, errorValue));
    return TCL_ERROR;

Changes to tests/binary.test.

639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
} abobarblat

test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format u0a3 abc abd
} -result {bad field specifier "u"}

test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
    binary s
} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
    binary scan foo
} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
    binary scan {} {}
} 0






|







639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
} abobarblat

test binary-18.1 {Tcl_BinaryObjCmd: format} -returnCodes error -body {
    binary format u0a3 abc abd
} -result {bad field specifier "u"}

test binary-19.1 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
    binary sc
} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.2 {Tcl_BinaryObjCmd: errors} -returnCodes error -body {
    binary scan foo
} -result {wrong # args: should be "binary scan value formatString ?varName ...?"}
test binary-19.3 {Tcl_BinaryObjCmd: scan} {
    binary scan {} {}
} 0
2913
2914
2915
2916
2917
2918
2919



































































































































































































































































































































































































































































































































































































































































2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678]} -body {
    # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX <= 4):
    binary encode hex \U0001f415
    binary scan \U0001f415 a* v; set v
    set str {}
} -result {}




































































































































































































































































































































































































































































































































































































































































# ----------------------------------------------------------------------
# cleanup

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:






>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>










2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
test binary-78.1 {unicode (out of BMP) to byte-array conversion, bug-[bd94500678]} -body {
    # just test for BO-segfault (high surrogate w/o advance source pointer for out of BMP char if TCL_UTF_MAX <= 4):
    binary encode hex \U0001f415
    binary scan \U0001f415 a* v; set v
    set str {}
} -result {}

test binary-79.1 {binary set} {
    list [set x abc] [binary set x @1c 66] [set x]
} {abc {} aBc}
test binary-79.2 {binary set} -returnCodes error -body {
    binary set
} -result {wrong # args: should be "binary set varName formatString ?arg ...?"}
test binary-79.3 {binary set} -returnCodes error -body {
    binary set x
} -result {wrong # args: should be "binary set varName formatString ?arg ...?"}
test binary-79.4 {binary set} -returnCodes error -body {
    binary set x c
} -result {not enough arguments for all format specifiers}
test binary-79.5 {binary set} -setup {
    unset -nocomplain ary
    array set ary {x y}
} -returnCodes error -body {
    binary set ary c 1
} -cleanup {
    unset -nocomplain ary
} -result {can't set "ary": variable is array}
test binary-79.6 {binary set: errors prevent mutation} -setup {
    unset -nocomplain x
    set foo foo
    set bar bar
} -body {
    # Make unshared string
    set x [format %s%s $foo $bar]
    list [catch {binary set x ci 70 gorp} msg] $msg $x
} -cleanup {
    unset -nocomplain x
} -result {1 {expected integer but got "gorp"} foobar}
test binary-79.7 {binary set: errors prevent creation} -setup {
    unset -nocomplain nosuchvar
} -body {
    list [catch {binary set nosuchvar ci 70 gorp} msg] $msg \
	[info exist nosuchvar]
} -cleanup {
    unset -nocomplain nosuchvar
} -result {1 {expected integer but got "gorp"} 0}
test binary-79.8 {binary set: create variable} -setup {
    unset -nocomplain nosuchvar
} -body {
    binary set nosuchvar "c3" {65 66 67}
    return $nosuchvar
} -cleanup {
    unset -nocomplain nosuchvar
} -result ABC

test binary-80.1 {binary set: a} {
    set x abc
    binary set x a A
    binary encode hex $x
} 416263
test binary-80.2 {binary set: a} {
    set x abc
    binary set x a* AB
    binary encode hex $x
} 414263
test binary-80.3 {binary set: a} {
    set x abc
    binary set x a1 AB
    binary encode hex $x
} 416263
test binary-80.4 {binary set: a} {
    set x abc
    binary set x a2 A
    binary encode hex $x
} 410063

test binary-81.1 {binary set: A} {
    set x abc
    binary set x A A
    binary encode hex $x
} 416263
test binary-81.2 {binary set: A} {
    set x abc
    binary set x A* AB
    binary encode hex $x
} 414263
test binary-81.3 {binary set: A} {
    set x abc
    binary set x A1 AB
    binary encode hex $x
} 416263
test binary-81.4 {binary set: A} {
    set x abc
    binary set x A2 A
    binary encode hex $x
} 412063

test binary-82.1 {binary set: b} {
    set x abc
    binary set x b 10101010
    binary encode hex $x
} 016263
test binary-82.2 {binary set: b} {
    set x abc
    binary set x b* 1010101011011010
    binary encode hex $x
} 555b63
test binary-82.3 {binary set: b} {
    set x abc
    binary set x b4 1010101010101010
    binary encode hex $x
} 056263
test binary-82.4 {binary set: b, error case} {
    set x abc
    append x def
    list [catch {binary set x ab8 A 1010gorp} msg] $msg $x
} {1 {expected binary string but got "1010gorp" instead} abcdef}

test binary-83.1 {binary set: B} {
    set x abc
    binary set x B 10101010
    binary encode hex $x
} 806263
test binary-83.2 {binary set: B} {
    set x abc
    binary set x B* 0101010101101101
    binary encode hex $x
} 556d63
test binary-83.3 {binary set: B} {
    set x abc
    binary set x B4 1010101010101010
    binary encode hex $x
} a06263
test binary-83.4 {binary set: B, error case} {
    set x abc
    append x def
    list [catch {binary set x aB8 A 1010gorp} msg] $msg $x
} {1 {expected binary string but got "1010gorp" instead} abcdef}

test binary-84.1 {binary set: c} {
    set x abc
    binary set x c 65
    binary encode hex $x
} 416263
test binary-84.2 {binary set: c} {
    set x abc
    binary set x c* {65 66}
    binary encode hex $x
} 414263
test binary-84.3 {binary set: c} {
    set x abcdef
    binary set x c4 {65 66 67 68 69}
    binary encode hex $x
} 414243446566
test binary-83.4 {binary set: c, error case} {
    set x abc
    append x def
    list [catch {binary set x ac A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-83.5 {binary set: c, error case} {
    set x abc
    append x def
    list [catch {binary set x ac2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-85.1 {binary set: h} {
    set x abc
    binary set x h abcdef
    binary encode hex $x
} 0a6263
test binary-85.2 {binary set: h} {
    set x abc
    binary set x h* 1424
    binary encode hex $x
} 414263
test binary-85.3 {binary set: h} {
    set x abc
    binary set x h4 142434
    binary encode hex $x
} 414263
test binary-85.4 {binary set: h, error case} {
    set x abc
    append x def
    list [catch {binary set x ah8 A 1010gorp} msg] $msg $x
} {1 {expected hexadecimal string but got "1010gorp" instead} abcdef}

test binary-86.1 {binary set: H} {
    set x abc
    binary set x H abcdef
    binary encode hex $x
} a06263
test binary-86.2 {binary set: H} {
    set x abc
    binary set x H* 4142
    binary encode hex $x
} 414263
test binary-86.3 {binary set: H} {
    set x abc
    binary set x H4 414243
    binary encode hex $x
} 414263
test binary-86.4 {binary set: H, error case} {
    set x abc
    append x def
    list [catch {binary set x aH8 A 1010gorp} msg] $msg $x
} {1 {expected hexadecimal string but got "1010gorp" instead} abcdef}

test binary-87.1 {binary set: s} {
    set x abcdef
    binary set x s 65
    binary encode hex $x
} 410063646566
test binary-87.2 {binary set: s} {
    set x abcdef
    binary set x s* {65 66}
    binary encode hex $x
} 410042006566
test binary-87.3 {binary set: s} {
    set x abcdef
    binary set x s2 {65 -66 67 68 69}
    binary encode hex $x
} 4100beff6566
test binary-87.4 {binary set: s, error case} {
    set x abc
    append x def
    list [catch {binary set x as A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-87.5 {binary set: s, error case} {
    set x abc
    append x def
    list [catch {binary set x as2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-88.1 {binary set: S} {
    set x abcdef
    binary set x S 65
    binary encode hex $x
} 004163646566
test binary-88.2 {binary set: S} {
    set x abcdef
    binary set x S* {65 66}
    binary encode hex $x
} 004100426566
test binary-88.3 {binary set: S} {
    set x abcdef
    binary set x S2 {65 -66 67 68 69}
    binary encode hex $x
} 0041ffbe6566
test binary-83.4 {binary set: S, error case} {
    set x abc
    append x def
    list [catch {binary set x aS A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-83.5 {binary set: S, error case} {
    set x abc
    append x def
    list [catch {binary set x aS2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-89.1.BE {binary set: t} bigEndian {
    set x abcdef
    binary set x t 65
    binary encode hex $x
} 004163646566
test binary-89.2.BE {binary set: t} bigEndian {
    set x abcdef
    binary set x t* {65 66}
    binary encode hex $x
} 004100426566
test binary-89.3.BE {binary set: t} bigEndian {
    set x abcdef
    binary set x t2 {65 -66 67 68 69}
    binary encode hex $x
} 0041ffbe6566
test binary-89.1.LE {binary set: t} littleEndian {
    set x abcdef
    binary set x t 65
    binary encode hex $x
} 410063646566
test binary-89.2.LE {binary set: t} littleEndian {
    set x abcdef
    binary set x t* {65 66}
    binary encode hex $x
} 410042006566
test binary-89.3.LE {binary set: t} littleEndian {
    set x abcdef
    binary set x t2 {65 -66 67 68 69}
    binary encode hex $x
} 4100beff6566

test binary-90.1 {binary set: i} {
    set x abcdefghij
    binary set x i 65
    binary encode hex $x
} 4100000065666768696a
test binary-90.2 {binary set: i} {
    set x abcdefghij
    binary set x i* {65 66}
    binary encode hex $x
} 4100000042000000696a
test binary-90.3 {binary set: i} {
    set x abcdefghij
    binary set x i2 {65 -66 67 68 69}
    binary encode hex $x
} 41000000beffffff696a
test binary-90.4 {binary set: i, error case} {
    set x abc
    append x def
    list [catch {binary set x ai A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-90.5 {binary set: i, error case} {
    set x abc
    append x def
    list [catch {binary set x ai2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-91.1 {binary set: I} {
    set x abcdefghij
    binary set x I 65
    binary encode hex $x
} 0000004165666768696a
test binary-91.2 {binary set: I} {
    set x abcdefghij
    binary set x I* {65 66}
    binary encode hex $x
} 0000004100000042696a
test binary-91.3 {binary set: I} {
    set x abcdefghij
    binary set x I2 {65 -66 67 68 69}
    binary encode hex $x
} 00000041ffffffbe696a
test binary-91.4 {binary set: I, error case} {
    set x abc
    append x def
    list [catch {binary set x aI A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-91.5 {binary set: I, error case} {
    set x abc
    append x def
    list [catch {binary set x aI2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-92.1.BE {binary set: n} bigEndian {
    set x abcdefghij
    binary set x n 65
    binary encode hex $x
} 0000004165666768696a
test binary-92.2.BE {binary set: n} bigEndian {
    set x abcdefghij
    binary set x n* {65 66}
    binary encode hex $x
} 0000004100000042696a
test binary-92.3.BE {binary set: n} bigEndian {
    set x abcdefghij
    binary set x n2 {65 -66 67 68 69}
    binary encode hex $x
} 00000041ffffffbe696a
test binary-92.1.LE {binary set: n} littleEndian {
    set x abcdefghij
    binary set x n 65
    binary encode hex $x
} 4100000065666768696a
test binary-92.2.LE {binary set: n} littleEndian {
    set x abcdefghij
    binary set x n* {65 66}
    binary encode hex $x
} 4100000042000000696a
test binary-92.3.LE {binary set: n} littleEndian {
    set x abcdefghij
    binary set x n2 {65 -66 67 68 69}
    binary encode hex $x
} 41000000beffffff696a

test binary-93.1 {binary set: w} {
    set x abcdefghijklmnopqr
    binary set x w 65
    binary encode hex $x
} 4100000000000000696a6b6c6d6e6f707172
test binary-93.2 {binary set: w} {
    set x abcdefghijklmnopqr
    binary set x w* {65 66}
    binary encode hex $x
} 410000000000000042000000000000007172
test binary-93.3 {binary set: w} {
    set x abcdefghijklmnopqr
    binary set x w2 {65 -66 67 68 69}
    binary encode hex $x
} 4100000000000000beffffffffffffff7172
test binary-93.4 {binary set: w, error case} {
    set x abc
    append x def
    list [catch {binary set x aw A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-93.5 {binary set: w, error case} {
    set x abc
    append x def
    list [catch {binary set x aw2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-94.1 {binary set: W} {
    set x abcdefghijklmnopqr
    binary set x W 65
    binary encode hex $x
} 0000000000000041696a6b6c6d6e6f707172
test binary-94.2 {binary set: W} {
    set x abcdefghijklmnopqr
    binary set x W* {65 66}
    binary encode hex $x
} 000000000000004100000000000000427172
test binary-94.3 {binary set: W} {
    set x abcdefghijklmnopqr
    binary set x W2 {65 -66 67 68 69}
    binary encode hex $x
} 0000000000000041ffffffffffffffbe7172
test binary-94.4 {binary set: W, error case} {
    set x abc
    append x def
    list [catch {binary set x aW A gorp} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}
test binary-94.5 {binary set: W, error case} {
    set x abc
    append x def
    list [catch {binary set x aW2 A {65 gorp}} msg] $msg $x
} {1 {expected integer but got "gorp"} abcdef}

test binary-95.1.BE {binary set: m} bigEndian {
    set x abcdefghijklmnopqr
    binary set x m 65
    binary encode hex $x
} 0000000000000041696a6b6c6d6e6f707172
test binary-95.2.BE {binary set: m} bigEndian {
    set x abcdefghijklmnopqr
    binary set x m* {65 66}
    binary encode hex $x
} 000000000000004100000000000000427172
test binary-95.3.BE {binary set: m} bigEndian {
    set x abcdefghijklmnopqr
    binary set x m2 {65 -66 67 68 69}
    binary encode hex $x
} 0000000000000041ffffffffffffffbe7172
test binary-95.1.LE {binary set: m} littleEndian {
    set x abcdefghijklmnopqr
    binary set x m 65
    binary encode hex $x
} 4100000000000000696a6b6c6d6e6f707172
test binary-95.2.LE {binary set: m} littleEndian {
    set x abcdefghijklmnopqr
    binary set x m* {65 66}
    binary encode hex $x
} 410000000000000042000000000000007172
test binary-95.3.LE {binary set: m} littleEndian {
    set x abcdefghijklmnopqr
    binary set x m2 {65 -66 67 68 69}
    binary encode hex $x
} 4100000000000000beffffffffffffff7172

test binary-96.1 {binary set: r} {
    set x abcdefghij
    binary set x r 65.3
    binary encode hex $x
} 9a99824265666768696a
test binary-96.2 {binary set: r} {
    set x abcdefghij
    binary set x r* {65.3 66.6}
    binary encode hex $x
} 9a99824233338542696a
test binary-96.3 {binary set: r} {
    set x abcdefghij
    binary set x r2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 9a998242333385c2696a

test binary-97.1 {binary set: R} {
    set x abcdefghij
    binary set x R 65.3
    binary encode hex $x
} 4282999a65666768696a
test binary-97.2 {binary set: R} {
    set x abcdefghij
    binary set x R* {65.3 66.6}
    binary encode hex $x
} 4282999a42853333696a
test binary-97.3 {binary set: R} {
    set x abcdefghij
    binary set x R2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 4282999ac2853333696a

test binary-98.1.BE {binary set: f} bigEndian {
    set x abcdefghij
    binary set x f 65.3
    binary encode hex $x
} 4282999a65666768696a
test binary-98.2.BE {binary set: f} bigEndian {
    set x abcdefghij
    binary set x f* {65.3 66.6}
    binary encode hex $x
} 4282999a42853333696a
test binary-98.3.BE {binary set: f} bigEndian {
    set x abcdefghij
    binary set x f2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 4282999ac2853333696a
test binary-98.1.LE {binary set: f} littleEndian {
    set x abcdefghij
    binary set x f 65.3
    binary encode hex $x
} 9a99824265666768696a
test binary-98.2.LE {binary set: f} littleEndian {
    set x abcdefghij
    binary set x f* {65.3 66.6}
    binary encode hex $x
} 9a99824233338542696a
test binary-98.3.LE {binary set: f} littleEndian {
    set x abcdefghij
    binary set x f2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 9a998242333385c2696a
test binary-98.4 {binary set: f, error case} {
    set x abc
    append x def
    list [catch {binary set x af A gorp} msg] $msg $x
} {1 {expected floating-point number but got "gorp"} abcdef}
test binary-98.5 {binary set: f, error case} {
    set x abc
    append x def
    list [catch {binary set x af2 A {65 gorp}} msg] $msg $x
} {1 {expected floating-point number but got "gorp"} abcdef}

test binary-99.1 {binary set: q} {
    set x abcdefghijklmnopqr
    binary set x q 65.3
    binary encode hex $x
} 3333333333535040696a6b6c6d6e6f707172
test binary-99.2 {binary set: q} {
    set x abcdefghijklmnopqr
    binary set x q* {65.3 66.6}
    binary encode hex $x
} 33333333335350406666666666a650407172
test binary-99.3 {binary set: q} {
    set x abcdefghijklmnopqr
    binary set x q2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 33333333335350406666666666a650c07172

test binary-100.1 {binary set: Q} {
    set x abcdefghijklmnopqr
    binary set x Q 65.3
    binary encode hex $x
} 4050533333333333696a6b6c6d6e6f707172
test binary-100.2 {binary set: Q} {
    set x abcdefghijklmnopqr
    binary set x Q* {65.3 66.6}
    binary encode hex $x
} 40505333333333334050a666666666667172
test binary-100.3 {binary set: Q} {
    set x abcdefghijklmnopqr
    binary set x Q2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 4050533333333333c050a666666666667172

test binary-101.1.BE {binary set: d} bigEndian {
    set x abcdefghijklmnopqr
    binary set x d 65.3
    binary encode hex $x
} 4050533333333333696a6b6c6d6e6f707172
test binary-101.2.BE {binary set: d} bigEndian {
    set x abcdefghijklmnopqr
    binary set x d* {65.3 66.6}
    binary encode hex $x
} 40505333333333334050a666666666667172
test binary-101.3.BE {binary set: d} bigEndian {
    set x abcdefghijklmnopqr
    binary set x d2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 4050533333333333c050a666666666667172
test binary-101.1.LE {binary set: d} littleEndian {
    set x abcdefghijklmnopqr
    binary set x d 65.3
    binary encode hex $x
} 3333333333535040696a6b6c6d6e6f707172
test binary-101.2.LE {binary set: d} littleEndian {
    set x abcdefghijklmnopqr
    binary set x d* {65.3 66.6}
    binary encode hex $x
} 33333333335350406666666666a650407172
test binary-101.3.LE {binary set: d} littleEndian {
    set x abcdefghijklmnopqr
    binary set x d2 {65.3 -66.6 67.1 68.8 69.2}
    binary encode hex $x
} 33333333335350406666666666a650c07172
test binary-101.4 {binary set: d, error case} {
    set x abc
    append x def
    list [catch {binary set x ad A gorp} msg] $msg $x
} {1 {expected floating-point number but got "gorp"} abcdef}
test binary-101.5 {binary set: d, error case} {
    set x abc
    append x def
    list [catch {binary set x ad2 A {65 gorp}} msg] $msg $x
} {1 {expected floating-point number but got "gorp"} abcdef}

test binary-102.1 {binary set: x} {
    set x abc
    binary set x x
    binary encode hex $x
} 006263
test binary-102.2 {binary set: x} {
    set x abc
    binary set x x2
    binary encode hex $x
} 000063

test binary-103.1 {binary set: X} {
    set x abcdef
    binary set x a2Xa AB Z
    binary encode hex $x
} 415a63646566
test binary-103.2 {binary set: X} {
    set x abcdef
    binary set x a4X2a ABCD Z
    binary encode hex $x
} 41425a446566
test binary-103.3 {binary set: X} {
    set x abcdef
    binary set x a2X4a ABCD Z
    binary encode hex $x
} 5a4263646566
test binary-103.4 {binary set: X} {
    set x abcdef
    binary set x a2X*a ABCD Z
    binary encode hex $x
} 5a4263646566

test binary-104.1 {binary set: @} {
    set x abcdef
    binary set x [email protected] ABCD Z
    binary encode hex $x
} 41425a446566
test binary-104.2 {binary set: @} {
    set x abcdef
    binary set x [email protected] ABCD Z
    binary encode hex $x
} 414263645a66
test binary-104.3 {binary set: @} {
    set x abcdef
    binary set x [email protected]*a ABCD Z
    binary encode hex $x
} 4142636465665a

# ----------------------------------------------------------------------
# cleanup

::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End: