Permalink
Browse files

Initial commit

  • Loading branch information...
0 parents commit 3185d6d46ba6fc38fef5414c92dc1f7cd2ce20cd @uasi committed May 23, 2010
Showing with 328 additions and 0 deletions.
  1. +18 −0 Makefile
  2. +12 −0 lib/MessagePack.pm6
  3. +179 −0 lib/MessagePack/Unpacker.pm6
  4. +94 −0 t/00-unpack.t
  5. +25 −0 t/harness
@@ -0,0 +1,18 @@
+PERL = perl
+PARROT_CONFIG = parrot_config
+BIN_DIR = `$(PARROT_CONFIG) bindir`
+LIB_DIR = `$(PARROT_CONFIG) libdir`
+TOOLS_LIB_DIR = $(LIB_DIR)`$(PARROT_CONFIG) versiondir`/tools/lib
+
+.PHONY: all test
+
+all:
+
+test:
+ $(PERL) -I$(TOOLS_LIB_DIR) t/harness --bindir=$(BIN_DIR)
+
+# Local variables:
+# mode: makefile
+# End:
+# vim: ft=make:
+
@@ -0,0 +1,12 @@
+use v6;
+
+module MessagePack;
+
+use MessagePack::Unpacker;
+
+sub unpack($str) {
+ MessagePack::Unpacker.unpack($str);
+}
+
+# vim: ft=perl6 :
+
@@ -0,0 +1,179 @@
+use v6;
+
+class MessagePack::Unpacker {
+ role Readable {
+ has $!pos = 0;
+
+ method read($bytes) {
+ fail if $!pos + $bytes > self.bytes;
+ my $s = self.substr($!pos, $bytes);
+ $!pos += $bytes;
+ $s;
+ }
+
+ method read-bytes($bytes) {
+ self.read($bytes).comb>>.ord;
+ }
+
+ method eos() {
+ $!pos == self.bytes;
+ }
+ }
+
+ has $!str;
+
+ my %unpack-for-type = (
+ 0xc0 => { Nil },
+ 0xc2 => { False },
+ 0xc3 => { True },
+ 0xca => { $_!unpack-float },
+ 0xcb => { $_!unpack-double },
+ 0xcc => { $_!unpack-uint8 },
+ 0xcd => { $_!unpack-uint16 },
+ 0xce => { $_!unpack-uint32 },
+ 0xcf => { $_!unpack-uint64 },
+ 0xd0 => { $_!unpack-int8 },
+ 0xd1 => { $_!unpack-int16 },
+ 0xd2 => { $_!unpack-int32 },
+ 0xd3 => { $_!unpack-int64 },
+ 0xda => { $_!unpack-raw( bytes => $_!unpack-uint16) },
+ 0xdb => { $_!unpack-raw( bytes => $_!unpack-uint32) },
+ 0xdc => { $_!unpack-array(elems => $_!unpack-uint16) },
+ 0xdd => { $_!unpack-array(elems => $_!unpack-uint32) },
+ 0xde => { $_!unpack-map( pairs => $_!unpack-uint16) },
+ 0xdf => { $_!unpack-map( pairs => $_!unpack-uint32) },
+ );
+
+ submethod BUILD($str) {
+ $!str = $str but Readable;
+ }
+
+ method new($str) {
+ self.bless(*, :$str);
+ }
+
+ # Class method
+ method unpack($str) {
+ my $unpacker = self.new($str);
+ $unpacker!unpack;
+ }
+
+ method !unpack() {
+ my $type = self!unpack-uint8;
+
+ return (given $type {
+ when ($type +& 0b1000_0000) == 0b0000_0000 {
+ # positive fixnum
+ $type;
+ }
+ when ($type +& 0b1110_0000) == 0b1110_0000 {
+ # negative fixnum
+ ($type +& 0b0001_1111) - 32;
+ }
+ when ($type +& 0b1110_0000) == 0b1010_0000 {
+ # fixraw
+ self!unpack-raw(bytes => $type +& 0b1_1111);
+ }
+ when ($type +& 0b1111_0000) == 0b1001_0000 {
+ # fixarray
+ self!unpack-array(elems => $type +& 0b1111);
+ }
+ when ($type +& 0b1111_0000) == 0b1000_0000 {
+ # fixmap
+ self!unpack-map(pairs => $type +& 0b1111);
+ }
+ when %unpack-for-type.exists($type) {
+ %unpack-for-type{$type}(self);
+ }
+ default {
+ fail sprintf("Unknown type 0x%02x", $type);
+ }
+ });
+ }
+
+ method !unpack-uint8() {
+ $!str.read-bytes(1)[0];
+ }
+
+ method !unpack-uint16() {
+ my @bytes = $!str.read-bytes(2);
+ (@bytes[0] +< 8) +|
+ (@bytes[1] );
+ }
+
+ method !unpack-uint32() {
+ my @bytes = $!str.read-bytes(4);
+ (@bytes[0] +< 24) +|
+ (@bytes[1] +< 16) +|
+ (@bytes[2] +< 8) +|
+ (@bytes[3] );
+ }
+
+ method !unpack-uint64() {
+ my @bytes = $!str.read-bytes(8);
+ (@bytes[0] +< 56) +|
+ (@bytes[1] +< 48) +|
+ (@bytes[2] +< 40) +|
+ (@bytes[3] +< 32) +|
+ (@bytes[4] +< 24) +|
+ (@bytes[5] +< 16) +|
+ (@bytes[6] +< 8) +|
+ (@bytes[7] );
+ }
+
+ method !unpack-int8() {
+ my $uint8 = self!unpack-uint8;
+ ($uint8 < (1 +< 7)) ?? $uint8 !! $uint8 - (1 +< 8);
+ }
+
+ method !unpack-int16() {
+ my $uint16 = self!unpack-uint16;
+ ($uint16 < (1 +< 15)) ?? $uint16 !! $uint16 - (1 +< 16);
+ }
+
+ method !unpack-int32() {
+ my $uint32 = self!unpack-uint32;
+ ($uint32 < (1 +< 31)) ?? $uint32 !! $uint32 - (1 +< 32);
+ }
+
+ method !unpack-int64() {
+ my $uint64 = self!unpack-uint64;
+ ($uint64 < (1 +< 15)) ?? $uint64 !! $uint64 - (1 +< 64);
+ }
+
+ method !unpack-float() {
+ my $v = self!unpack-uint32;
+ return 0.0 if $v == 0;
+
+ my $sign = $v +> 31 ?? -1 !! 1;
+ my $exp = (($v +> 23) +& 0xff) - 127;
+ my $frac = ($v +& 0x7f_ffff) +| 0x80_0000;
+ $sign * ($frac * 2 ** ($exp - 23));
+ }
+
+ method !unpack-double() {
+ my $hi = self!unpack-uint32;
+ my $lo = self!unpack-uint32;
+ return 0.0 if $hi == $lo == 0;
+
+ my $sign = $hi +> 31 ?? -1 !! 1;
+ my $exp = (($hi +> 20) +& 0x7ff) - 1023;
+ my $hfrac = ($hi +& 0xf_ffff) +| 0x10_0000;
+ $sign * (($hfrac * 2 ** ($exp - 20)) + 132 * ($lo * 2 ** ($exp - 52)));
+ }
+
+ method !unpack-raw($bytes) {
+ $!str.read($bytes);
+ }
+
+ method !unpack-array($elems) {
+ list(gather for ^$elems { take self!unpack });
+ }
+
+ method !unpack-map($pairs) {
+ hash(gather for ^$pairs { take self!unpack => self!unpack });
+ }
+}
+
+# vim: ft=perl6
+
@@ -0,0 +1,94 @@
+use v6;
+
+use Test;
+use MessagePack::Unpacker;
+
+plan 61;
+
+$_ = MessagePack::Unpacker;
+
+is .unpack("\x00"), 0x00, q[positive fixnum];
+is .unpack("\x7f"), 0x7f, q[positive fixnum];
+
+is .unpack("\xff"), -0x01, q[negative fixnum];
+is .unpack("\xe0"), -0x20, q[negative fixnum];
+
+is .unpack("\xcc\x00"), 0x00, q[uint8];
+is .unpack("\xcc\xff"), 0xff, q[uint8];
+
+is .unpack("\xcd\x00\x00"), 0x0000, q[uint16];
+is .unpack("\xcd\x00\x01"), 0x0001, q[uint16];
+is .unpack("\xcd\xff\xff"), 0xffff, q[uint16];
+
+is .unpack("\xce\x00\x00\x00\x00"), 0x0000_0000, q[uint32];
+is .unpack("\xce\x00\x00\x00\x01"), 0x0000_0001, q[uint32];
+is .unpack("\xce\xff\xff\xff\xff"), 0xffff_ffff, q[uint32];
+
+is .unpack("\xcf" ~ "\x00" x 8 ), 0x0000_0000_0000_0000, q[uint64];
+is .unpack("\xcf" ~ "\x00" x 7 ~ "\x01"), 0x0000_0000_0000_0001, q[uint64];
+is .unpack("\xcf" ~ "\xff" x 8 ), 0xffff_ffff_ffff_ffff, q[uint64];
+
+is .unpack("\xd0\x00"), 0x00, q[int8];
+is .unpack("\xd0\x7f"), 0x7f, q[int8];
+is .unpack("\xd0\xff"), -0x01, q[int8];
+is .unpack("\xd0\x80"), -0x80, q[int8];
+
+is .unpack("\xd1\x00\x00"), 0x0000, q[int16];
+is .unpack("\xd1\x7f\xff"), 0x7fff, q[int16];
+is .unpack("\xd1\xff\xff"), -0x0001, q[int16];
+is .unpack("\xd1\x80\x00"), -0x8000, q[int16];
+
+is .unpack("\xd2\x00\x00\x00\x00"), 0x0000_0000, q[int32];
+is .unpack("\xd2\x7f\xff\xff\xff"), 0x7fff_ffff, q[int32];
+is .unpack("\xd2\xff\xff\xff\xff"), -0x0000_0001, q[int32];
+is .unpack("\xd2\x80\x00\x00\x00"), -0x8000_0000, q[int32];
+
+is .unpack("\xd3" ~ "\x00" x 8), 0x0000_0000_0000_0000, q[int64];
+is .unpack("\xd3\x7f" ~ "\xff" x 7), 0x7fff_ffff_ffff_ffff, q[int64];
+is .unpack("\xd3" ~ "\xff" x 8), -0x0000_0000_0000_0001, q[int64];
+is .unpack("\xd3\x80" ~ "\x00" x 7), -0x8000_0000_0000_0000, q[int64];
+
+is .unpack("\xc0"), Nil, q[nil];
+is .unpack("\xc2"), False, q[false];
+is .unpack("\xc3"), True, q[true];
+
+is .unpack("\xca\x00\x00\x00\x00"), 0.0, q[float];
+is .unpack("\xca\x3f\x00\x00\x00"), 0.5, q[float];
+is .unpack("\xca\xbf\x00\x00\x00"), -0.5, q[float];
+
+is .unpack("\xcb\x00\x00\x00\x00\x00\x00\x00\x00"), 0.0, q[double];
+is .unpack("\xcb\x3f\xe0\x00\x00\x00\x00\x00\x00"), 0.5, q[double];
+is .unpack("\xcb\xbf\xe0\x00\x00\x00\x00\x00\x00"), -0.5, q[double];
+
+is .unpack("\xa0" ~ "" ), "", q[fixraw];
+is .unpack("\xa3" ~ "ABC" ), "ABC", q[fixfaw];
+is .unpack("\xbf" ~ "A" x 31), "A" x 31, q[fixraw];
+
+is .unpack("\xda\x00\x00" ~ "" ), "", q[raw16];
+is .unpack("\xda\x00\x03" ~ "ABC" ), "ABC", q[raw16];
+is .unpack("\xda\xff\xff" ~ "A" x 0xffff), "A" x 0xffff, q[raw16];
+
+is .unpack("\xdb\x00\x00\x00\x00" ~ "" ), "", q[raw32];
+is .unpack("\xdb\x00\x00\x00\x03" ~ "ABC" ), "ABC", q[raw32];
+is .unpack("\xdb\x00\x01\x00\x00" ~ "A" x 0x1_0000), "A" x 0x1_0000, q[raw32];
+
+is .unpack("\x90" ), [], q[fixarray];
+is .unpack("\x93\x00\x01\x02"), [0, 1, 2], q[fixarray];
+
+is .unpack("\xdc\x00\x00" ), [], q[array16];
+is .unpack("\xdc\x00\x03\x00\x01\x02"), [0, 1, 2], q[array16];
+
+is .unpack("\xdd\x00\x00\x00\x00" ), [], q[array32];
+is .unpack("\xdd\x00\x00\x00\x03\x00\x01\x02"), [0, 1, 2], q[array32];
+
+is .unpack("\x80" ), {}, q[fixmap];
+is .unpack("\x82\x00\x01\x02\x03"), {0 => 1, 2 => 3}, q[fixmap];
+
+is .unpack("\xde\x00\x00" ), {}, q[map16];
+is .unpack("\xde\x00\x02\x00\x01\x02\x03"), {0 => 1, 2 => 3}, q[map16];
+
+is .unpack("\xdf\x00\x00\x00\x00" ), {}, q[map32];
+is .unpack("\xdf\x00\x00\x00\x02\x00\x01\x02\x03"), {0 => 1, 2 => 3}, q[map32];
+
+# vim: ft=perl6 :
+
@@ -0,0 +1,25 @@
+#!/usr/bin/env perl
+
+use 5.008;
+use strict;
+use warnings;
+use Getopt::Long;
+
+my %harness_args = (
+ language => 'perl6',
+ jobs => $ENV{TEST_JOBS} || 1,
+ verbosity => 1,
+ merge => 0,
+);
+
+GetOptions(
+ 'verbosity=i' => \$harness_args{verbosity},
+ 'bindir=s' => \my $bindir,
+ 'jobs:3' => \$harness_args{jobs},
+);
+
+
+$harness_args{exec} = [$bindir . '/perl6'];
+
+eval 'use Parrot::Test::Harness %harness_args';
+

0 comments on commit 3185d6d

Please sign in to comment.