Author: mdiep
Date: Mon Jan 8 15:31:43 2007
New Revision: 16505
Modified:
trunk/languages/tcl/src/binary.c
trunk/languages/tcl/t/cmd_binary.t
Log:
[tcl]: [binary] opcodes:
- Add support for f, n
- Add some more tests
Modified: trunk/languages/tcl/src/binary.c
==============================================================================
--- trunk/languages/tcl/src/binary.c (original)
+++ trunk/languages/tcl/src/binary.c Mon Jan 8 15:31:43 2007
@@ -13,6 +13,9 @@
{
char *c;
double *d;
+ float *f;
+ int *n;
+
int len;
PMC *value = PMCNULL;
int pos = *_pos;
@@ -35,6 +38,24 @@
VTABLE_set_number_native(interp, value, *d);
pos += len;
break;
+ case 'f':
+ len = sizeof(float)/sizeof(char);
+ if (pos + len > length)
+ break;
+ f = (float *)(binstr + pos);
+ value = pmc_new(interp, class_TclFloat);
+ VTABLE_set_number_native(interp, value, *f);
+ pos += len;
+ break;
+ case 'n':
+ len = sizeof(int)/sizeof(char);
+ if (pos + len > length)
+ break;
+ n = (int *)(binstr + pos);
+ value = pmc_new(interp, class_TclInt);
+ VTABLE_set_integer_native(interp, value, *n);
+ pos += len;
+ break;
}
(*_pos) = pos;
return value;
@@ -98,6 +119,9 @@
{
char c;
double d;
+ float f;
+ int n;
+
INTVAL len;
switch (field)
@@ -113,6 +137,18 @@
len = sizeof(double)/sizeof(char);
binstr = string_concat(interp, binstr, string_from_cstring(interp,
&d, len), len);
break;
+ /* a float */
+ case 'f':
+ f = (float)VTABLE_get_number(interp, value);
+ len = sizeof(float)/sizeof(char);
+ binstr = string_concat(interp, binstr, string_from_cstring(interp,
&f, len), len);
+ break;
+ /* a native integer */
+ case 'n':
+ n = (int)VTABLE_get_integer(interp, value);
+ len = sizeof(int)/sizeof(char);
+ binstr = string_concat(interp, binstr, string_from_cstring(interp,
&n, len), len);
+ break;
}
return binstr;
Modified: trunk/languages/tcl/t/cmd_binary.t
==============================================================================
--- trunk/languages/tcl/t/cmd_binary.t (original)
+++ trunk/languages/tcl/t/cmd_binary.t Mon Jan 8 15:31:43 2007
@@ -7,7 +7,7 @@
__DATA__
source lib/test_more.tcl
-plan 5
+plan 12
eval_is {binary} {wrong # args: should be "binary option ?arg arg ...?"} \
{binary: no args}
@@ -15,7 +15,30 @@
eval_is {binary foo} {bad option "foo": must be format or scan} \
{binary: bad subcommand}
+# we test the default precision (which is special) elsewhere
+# so just set a precision to work around a bug
+set tcl_precision 17
+
binary scan [binary format dccc -1.3 6 7 8] dcc* d c c*
is $d -1.3 {binary: reversible d}
is $c 6 {binary: reversible c}
is ${c*} {7 8} {binary: scan [format cc] c*}
+
+binary scan [binary format f -1.3] f f
+is $f -1.2999999523162842 {binary: reversible f}
+
+binary scan [binary format n 9] n n
+is $n 9 {binary: reversible n}
+
+set TODO {TODO unimplemented}
+
+binary scan [binary format A6A foo bar] A* string
+eval_is {set string} {foo b} {binary: format A6A, scan A*} $TODO
+
+binary scan [binary format A* {foo bar}] A7 string
+eval_is {set string} {foo bar} {binary: format A*, scan A7} $TODO
+
+binary scan [binary format a4a foo bar] a3ca string1 c string2
+eval_is {set string1} foo {binary: format a4a, scan a3ca} $TODO
+eval_is {set c} 0 {binary: format a4a, scan a3ca} $TODO
+eval_is {set string2} b {binary: format a4a, scan a3ca} $TODO
