mirror of
https://github.com/msgpack/msgpack-c.git
synced 2025-03-18 12:34:15 +01:00
More tests; some fails now :(
This commit is contained in:
parent
8eaed95e02
commit
562de7926b
1
perl/.gitignore
vendored
1
perl/.gitignore
vendored
@ -6,6 +6,7 @@ MessagePack.o
|
||||
blib/
|
||||
inc/
|
||||
msgpack/
|
||||
t/std/
|
||||
pack.o
|
||||
pm_to_blib
|
||||
unpack.o
|
||||
|
@ -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
|
||||
|
@ -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 }
|
||||
|
@ -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
35
perl/t/09_stddata.t
Normal 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;
|
@ -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
|
||||
|
Loading…
x
Reference in New Issue
Block a user