More tests; some fails now :(

This commit is contained in:
gfx 2010-09-16 21:37:49 +09:00
parent 8eaed95e02
commit 562de7926b
6 changed files with 56 additions and 3 deletions

1
perl/.gitignore vendored
View File

@ -6,6 +6,7 @@ MessagePack.o
blib/
inc/
msgpack/
t/std/
pack.o
pm_to_blib
unpack.o

View File

@ -54,6 +54,11 @@ if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) {
for my $src (<../msgpack/*.h>) {
File::Copy::copy($src, 'msgpack/') or die "copy failed: $!";
}
mkdir 't/std';
for my $data(<../test/*.{json,mpac}>) {
File::Copy::copy($data, 't/std') or die "copy failed: $!";
}
}
requires 'Test::More' => 0.94; # done_testing

View File

@ -6,6 +6,18 @@ use 5.008001;
our $VERSION = '0.23';
our $PreferInteger = 0;
{
package
Data::MessagePack::Boolean;
use overload
'bool' => sub { ${ $_[0] } },
'0+' => sub { ${ $_[0] } },
'""' => sub { ${ $_[0] } ? 'true' : 'false' },
fallback => 1,
;
}
our $true = do { bless \(my $dummy = 1), "Data::MessagePack::Boolean" };
our $false = do { bless \(my $dummy = 0), "Data::MessagePack::Boolean" };
sub true () { $true }

View File

@ -35,7 +35,7 @@ is_deeply(Data::MessagePack->unpack($packed), $input);
while( read($stream, $buff, $size) ) {
note "buff: ", join " ", map { unpack 'H2', $_ } split //, $buff;
$up->execute($buff, 0);
$up->execute($buff);
}
ok $up->is_finished, 'is_finished';
my $data = $up->data;

35
perl/t/09_stddata.t Normal file
View File

@ -0,0 +1,35 @@
use strict;
use Test::More;
use Test::Requires qw(JSON);
use t::Util;
use Data::MessagePack;
sub slurp {
open my $fh, '<:raw', $_[0] or die "failed to open '$_[0]': $!";
local $/;
return scalar <$fh>;
}
my @data = @{ JSON::decode_json(slurp("t/std/cases.json")) };
my $mpac1 = slurp("t/std/cases.mpac");
my $mpac2 = slurp("t/std/cases_compact.mpac");
my $mps = Data::MessagePack::Unpacker->new();
my $t = 1;
for my $mpac($mpac1, $mpac2) {
note "mpac", $t++;
my $offset = 0;
my $i = 0;
while($offset < length($mpac)) {
$offset += $mps->execute($mpac, $offset);
is_deeply $mps->data, $data[$i], "data[$i]";
$mps->reset;
$i++;
}
}
done_testing;

View File

@ -239,7 +239,7 @@ class MessagePackTestPackUnpack < Test::Unit::TestCase
end
it "gc mark" do
obj = [{["a","b"]=>["c","d"]}, ["e","f"], "d"]
obj = [1024, {["a","b"]=>["c","d"]}, ["e","f"], "d", 70000, 4.12, 1.5, 1.5, 1.5]
num = 4
raw = obj.to_msgpack * num
pac = MessagePack::Unpacker.new
@ -257,7 +257,7 @@ class MessagePackTestPackUnpack < Test::Unit::TestCase
end
it "streaming backward compatibility" do
obj = [{["a","b"]=>["c","d"]}, ["e","f"], "d"]
obj = [1024, {["a","b"]=>["c","d"]}, ["e","f"], "d", 70000, 4.12, 1.5, 1.5, 1.5]
num = 4
raw = obj.to_msgpack * num
pac = MessagePack::Unpacker.new