diff --git a/perl/.gitignore b/perl/.gitignore
index 3e0e73e..1656847 100644
--- a/perl/.gitignore
+++ b/perl/.gitignore
@@ -1,4 +1,5 @@
META.yml
+MYMETA.yml
Makefile
Makefile.old
MessagePack.bs
diff --git a/perl/Changes b/perl/Changes
index ce52581..d338cf8 100644
--- a/perl/Changes
+++ b/perl/Changes
@@ -1,7 +1,8 @@
0.24
- - Fixed a possible SEGV on streaming unpacking (gfx)
- - Improve performance, esp. in unpacking (gfx)
+ - Fixed a lot of streaming unpacking issues (tokuhirom, gfx)
+ - Fixed unpacking issues for 64 bit integers on 32 bit perls (gfx)
+ - Improved performance, esp. in unpacking (gfx)
0.23
diff --git a/perl/MANIFEST.SKIP b/perl/MANIFEST.SKIP
index 71a24e5..1d2192f 100644
--- a/perl/MANIFEST.SKIP
+++ b/perl/MANIFEST.SKIP
@@ -2,6 +2,7 @@
\bCVS\b
^MANIFEST\.
^Makefile$
+^MYMETA\.yml$
~$
^#
\.old$
diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index fafc387..b5d2701 100644
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -1,3 +1,5 @@
+# Usage: Makefile.PL --pp # disable XS
+# Makefile.PL -g # add -g to the compiler and disable optimization flags
use inc::Module::Install;
use Module::Install::XSUtil 0.32;
use Config;
@@ -21,8 +23,9 @@ if ( $] >= 5.008005 and want_xs() ) {
if ( $has_c99 ) {
use_xshelper();
cc_src_paths('xs-src');
- if ($ENV{DEBUG}) {
- cc_append_to_ccflags '-g';
+
+ if($Module::Install::AUTHOR) {
+ postamble qq{test :: test_pp\n\n};
}
}
else {
@@ -37,6 +40,7 @@ NOT_SUPPORT_C99
}
else {
print "configure PP version\n\n";
+ requires 'Math::BigInt' => 1.95; # old versions of BigInt were broken
}
clean_files qw{
@@ -66,10 +70,6 @@ test_requires('Test::Requires');
test_with_env( test_pp => PERL_DATA_MESSAGEPACK => 'pp' );
-if($Module::Install::AUTHOR) {
- postamble qq{test :: test_pp\n\n};
-}
-
repository('http://github.com/msgpack/msgpack');
auto_include;
WriteAll;
diff --git a/perl/README b/perl/README
index 3105278..224ff08 100644
--- a/perl/README
+++ b/perl/README
@@ -2,6 +2,8 @@ NAME
Data::MessagePack - MessagePack serialising/deserialising
SYNOPSIS
+ use Data::MessagePack;
+
my $packed = Data::MessagePack->pack($dat);
my $unpacked = Data::MessagePack->unpack($dat);
@@ -51,7 +53,8 @@ Configuration Variables
SPEED
This is a result of benchmark/serialize.pl and benchmark/deserialize.pl
- on my SC440(Linux 2.6.32-23-server #37-Ubuntu SMP).
+ on my SC440(Linux 2.6.32-23-server #37-Ubuntu SMP). (You should
+ benchmark them with your data if the speed matters, of course.)
-- serialize
JSON::XS: 2.3
@@ -79,6 +82,12 @@ SPEED
json 179443/s 56% -- -16%
mp 212910/s 85% 19% --
+CAVEAT
+ Unpacking 64 bit integers
+ This module can unpack 64 bit integers even if your perl does not
+ support them (i.e. where "perl -V:ivsize" is 4), but you cannot
+ calculate these values unless you use "Math::BigInt".
+
TODO
Error handling
MessagePack cannot deal with complex scalars such as object
@@ -117,3 +126,7 @@ SEE ALSO
is the official web site for the MessagePack
format.
+ Data::MessagePack::Unpacker
+
+ AnyEvent::MPRPC
+
diff --git a/perl/benchmark/data.pl b/perl/benchmark/data.pl
new file mode 100755
index 0000000..6908d1c
--- /dev/null
+++ b/perl/benchmark/data.pl
@@ -0,0 +1,6 @@
++{
+ "method" => "handleMessage",
+ "params" => [ "user1", "we were just talking", "foo\nbar\nbaz\nqux" ],
+ "id" => undef,
+ "array" => [ 1, 1024, 70000, -5, 1e5, 1e7, 1, 0, 3.14, sqrt(2), 1 .. 100 ],
+};
diff --git a/perl/benchmark/deserialize.pl b/perl/benchmark/deserialize.pl
index 634a79e..faa2582 100644
--- a/perl/benchmark/deserialize.pl
+++ b/perl/benchmark/deserialize.pl
@@ -1,29 +1,25 @@
use strict;
use warnings;
use Data::MessagePack;
-use JSON::XS;
-use Benchmark ':all';
+use JSON;
use Storable;
+use Benchmark ':all';
#$Data::MessagePack::PreferInteger = 1;
-my $a = {
- "method" => "handleMessage",
- "params" => [ "user1", "we were just talking" ],
- "id" => undef,
- "array" => [ 1, 1024, 70000, -5, 1e5, 1e7, 1, 0, 3.14, sqrt(2) ],
-};
-my $j = JSON::XS::encode_json($a);
+my $a = do 'benchmark/data.pl';
+
+my $j = JSON::encode_json($a);
my $m = Data::MessagePack->pack($a);
my $s = Storable::freeze($a);
print "-- deserialize\n";
-print "JSON::XS: $JSON::XS::VERSION\n";
+print "$JSON::Backend: ", $JSON::Backend->VERSION, "\n";
print "Data::MessagePack: $Data::MessagePack::VERSION\n";
print "Storable: $Storable::VERSION\n";
cmpthese timethese(
-1 => {
- json => sub { JSON::XS::decode_json($j) },
+ json => sub { JSON::decode_json($j) },
mp => sub { Data::MessagePack->unpack($m) },
storable => sub { Storable::thaw($s) },
}
diff --git a/perl/benchmark/serialize.pl b/perl/benchmark/serialize.pl
index e0509ff..4982ff6 100644
--- a/perl/benchmark/serialize.pl
+++ b/perl/benchmark/serialize.pl
@@ -1,24 +1,19 @@
use strict;
use warnings;
use Data::MessagePack;
-use JSON::XS;
+use JSON;
use Storable;
use Benchmark ':all';
-my $a = {
- "method" => "handleMessage",
- "params" => [ "user1", "we were just talking" ],
- "id" => undef,
- "array" => [ 1, 1024, 70000, -5, 1e5, 1e7, 1, 0, 3.14, sqrt(2) ],
-};
+my $a = do 'benchmark/data.pl';
print "-- serialize\n";
-print "JSON::XS: $JSON::XS::VERSION\n";
+print "$JSON::Backend: ", $JSON::Backend->VERSION, "\n";
print "Data::MessagePack: $Data::MessagePack::VERSION\n";
print "Storable: $Storable::VERSION\n";
cmpthese timethese(
-1 => {
- json => sub { JSON::XS::encode_json($a) },
+ json => sub { JSON::encode_json($a) },
storable => sub { Storable::freeze($a) },
mp => sub { Data::MessagePack->pack($a) },
}
diff --git a/perl/lib/Data/MessagePack.pm b/perl/lib/Data/MessagePack.pm
index 953bdf8..154c5b1 100644
--- a/perl/lib/Data/MessagePack.pm
+++ b/perl/lib/Data/MessagePack.pm
@@ -23,7 +23,7 @@ sub false () {
}
if ( !__PACKAGE__->can('pack') ) { # this idea comes from Text::Xslate
- my $backend = $ENV{ PERL_DATA_MESSAGEPACK } || '';
+ my $backend = $ENV{PERL_DATA_MESSAGEPACK} || ($ENV{PERL_ONLY} ? 'pp' : '');
if ( $backend !~ /\b pp \b/xms ) {
eval {
require XSLoader;
@@ -45,6 +45,8 @@ Data::MessagePack - MessagePack serialising/deserialising
=head1 SYNOPSIS
+ use Data::MessagePack;
+
my $packed = Data::MessagePack->pack($dat);
my $unpacked = Data::MessagePack->unpack($dat);
@@ -55,7 +57,8 @@ This module converts Perl data structures to MessagePack and vice versa.
=head1 ABOUT MESSAGEPACK FORMAT
MessagePack is a binary-based efficient object serialization format.
-It enables to exchange structured objects between many languages like JSON. But unlike JSON, it is very fast and small.
+It enables to exchange structured objects between many languages like JSON.
+But unlike JSON, it is very fast and small.
=head2 ADVANTAGES
@@ -113,7 +116,7 @@ Packs a string as an integer, when it looks like an integer.
=head1 SPEED
This is a result of benchmark/serialize.pl and benchmark/deserialize.pl on my SC440(Linux 2.6.32-23-server #37-Ubuntu SMP).
-
+(You should benchmark them with B data if the speed matters, of course.)
-- serialize
JSON::XS: 2.3
@@ -141,6 +144,14 @@ This is a result of benchmark/serialize.pl and benchmark/deserialize.pl on my SC
json 179443/s 56% -- -16%
mp 212910/s 85% 19% --
+=head1 CAVEAT
+
+=head2 Unpacking 64 bit integers
+
+This module can unpack 64 bit integers even if your perl does not support them
+(i.e. where C<< perl -V:ivsize >> is 4), but you cannot calculate these values
+unless you use C.
+
=head1 TODO
=over
@@ -187,4 +198,8 @@ it under the same terms as Perl itself.
L is the official web site for the MessagePack format.
+L
+
+L
+
=cut
diff --git a/perl/lib/Data/MessagePack/PP.pm b/perl/lib/Data/MessagePack/PP.pm
index 0dd6427..44940de 100644
--- a/perl/lib/Data/MessagePack/PP.pm
+++ b/perl/lib/Data/MessagePack/PP.pm
@@ -12,17 +12,57 @@ use Carp ();
package
Data::MessagePack;
-use Scalar::Util qw( blessed );
use strict;
use B ();
BEGIN {
+ my $unpack_int64_slow;
+ my $unpack_uint64_slow;
+
+ if(!eval { pack 'Q', 1 }) { # don't have quad types
+ $unpack_int64_slow = sub {
+ require Math::BigInt;
+ my $high = unpack_uint32( $_[0], $_[1] );
+ my $low = unpack_uint32( $_[0], $_[1] + 4);
+
+ if($high < 0xF0000000) { # positive
+ $high = Math::BigInt->new( $high );
+ $low = Math::BigInt->new( $low );
+ return +($high << 32 | $low)->bstr;
+ }
+ else { # negative
+ $high = Math::BigInt->new( ~$high );
+ $low = Math::BigInt->new( ~$low );
+ return +( -($high << 32 | $low + 1) )->bstr;
+ }
+ };
+ $unpack_uint64_slow = sub {
+ require Math::BigInt;
+ my $high = Math::BigInt->new( unpack_uint32( $_[0], $_[1]) );
+ my $low = Math::BigInt->new( unpack_uint32( $_[0], $_[1] + 4) );
+ return +($high << 32 | $low)->bstr;
+ };
+ }
+
+ *unpack_uint16 = sub { return unpack 'n', substr( $_[0], $_[1], 2 ) };
+ *unpack_uint32 = sub { return unpack 'N', substr( $_[0], $_[1], 4 ) };
+
# for pack and unpack compatibility
if ( $] < 5.010 ) {
# require $Config{byteorder}; my $bo_is_le = ( $Config{byteorder} =~ /^1234/ );
# which better?
my $bo_is_le = unpack ( 'd', "\x00\x00\x00\x00\x00\x00\xf0\x3f") == 1; # 1.0LE
+ *unpack_int16 = sub {
+ my $v = unpack 'n', substr( $_[0], $_[1], 2 );
+ return $v ? $v - 0x10000 : 0;
+ };
+ *unpack_int32 = sub {
+ no warnings; # avoid for warning about Hexadecimal number
+ my $v = unpack 'N', substr( $_[0], $_[1], 4 );
+ return $v ? $v - 0x100000000 : 0;
+ };
+
# In reality, since 5.9.2 '>' is introduced. but 'n!' and 'N!'?
if($bo_is_le) {
*pack_uint64 = sub {
@@ -47,20 +87,11 @@ BEGIN {
return unpack( 'd', pack( 'N2', @v[1,0] ) );
};
- *unpack_int16 = sub {
- my $v = unpack 'n', substr( $_[0], $_[1], 2 );
- return $v ? $v - 0x10000 : 0;
- };
- *unpack_int32 = sub {
- no warnings; # avoid for warning about Hexadecimal number
- my $v = unpack 'N', substr( $_[0], $_[1], 4 );
- return $v ? $v - 0x100000000 : 0;
- };
- *unpack_int64 = sub {
+ *unpack_int64 = $unpack_int64_slow ||_sub {
my @v = unpack( 'V*', substr( $_[0], $_[1], 8 ) );
return unpack( 'q', pack( 'N2', @v[1,0] ) );
};
- *unpack_uint64 = sub {
+ *unpack_uint64 = $unpack_uint64_slow || sub {
my @v = unpack( 'V*', substr( $_[0], $_[1], 8 ) );
return unpack( 'Q', pack( 'N2', @v[1,0] ) );
};
@@ -72,17 +103,8 @@ BEGIN {
*unpack_float = sub { return unpack( 'f', substr( $_[0], $_[1], 4 ) ); };
*unpack_double = sub { return unpack( 'd', substr( $_[0], $_[1], 8 ) ); };
- *unpack_int16 = sub {
- my $v = unpack 'n', substr( $_[0], $_[1], 2 );
- return $v ? $v - 0x10000 : 0;
- };
- *unpack_int32 = sub {
- no warnings; # avoid for warning about Hexadecimal number
- my $v = unpack 'N', substr( $_[0], $_[1], 4 );
- return $v ? $v - 0x100000000 : 0;
- };
- *unpack_int64 = sub { pack 'q', substr( $_[0], $_[1], 8 ); };
- *unpack_uint64 = sub { pack 'Q', substr( $_[0], $_[1], 8 ); };
+ *unpack_int64 = $unpack_int64_slow || sub { pack 'q', substr( $_[0], $_[1], 8 ); };
+ *unpack_uint64 = $unpack_uint64_slow || sub { pack 'Q', substr( $_[0], $_[1], 8 ); };
}
}
else {
@@ -94,11 +116,15 @@ BEGIN {
*unpack_double = sub { return unpack( 'd>', substr( $_[0], $_[1], 8 ) ); };
*unpack_int16 = sub { return unpack( 'n!', substr( $_[0], $_[1], 2 ) ); };
*unpack_int32 = sub { return unpack( 'N!', substr( $_[0], $_[1], 4 ) ); };
- *unpack_int64 = sub { return unpack( 'q>', substr( $_[0], $_[1], 8 ) ); };
- *unpack_uint64 = sub { return unpack( 'Q>', substr( $_[0], $_[1], 8 ) ); };
+
+ *unpack_int64 = $unpack_int64_slow || sub { return unpack( 'q>', substr( $_[0], $_[1], 8 ) ); };
+ *unpack_uint64 = $unpack_uint64_slow || sub { return unpack( 'Q>', substr( $_[0], $_[1], 8 ) ); };
}
}
+sub _unexpected {
+ Carp::confess("Unexpected " . sprintf(shift, @_) . " found");
+}
#
# PACK
@@ -107,11 +133,11 @@ BEGIN {
{
no warnings 'recursion';
- my $max_depth;
+ our $_max_depth;
sub pack :method {
Carp::croak('Usage: Data::MessagePack->pack($dat [,$max_depth])') if @_ < 2;
- $max_depth = defined $_[2] ? $_[2] : 512; # init
+ $_max_depth = defined $_[2] ? $_[2] : 512; # init
return _pack( $_[1] );
}
@@ -119,6 +145,12 @@ sub pack :method {
sub _pack {
my ( $value ) = @_;
+ local $_max_depth = $_max_depth - 1;
+
+ if ( $_max_depth < 0 ) {
+ Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)");
+ }
+
return CORE::pack( 'C', 0xc0 ) if ( not defined $value );
if ( ref($value) eq 'ARRAY' ) {
@@ -127,11 +159,8 @@ sub _pack {
$num < 16 ? CORE::pack( 'C', 0x90 + $num )
: $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xdc, $num )
: $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdd, $num )
- : die "" # don't arrivie here
+ : _unexpected("number %d", $num)
;
- if ( --$max_depth <= 0 ) {
- Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)");
- }
return join( '', $header, map { _pack( $_ ) } @$value );
}
@@ -141,11 +170,8 @@ sub _pack {
$num < 16 ? CORE::pack( 'C', 0x80 + $num )
: $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xde, $num )
: $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdf, $num )
- : die "" # don't arrivie here
+ : _unexpected("number %d", $num)
;
- if ( --$max_depth <= 0 ) {
- Carp::croak("perl structure exceeds maximum nesting level (max_depth set too low?)");
- }
return join( '', $header, map { _pack( $_ ) } %$value );
}
@@ -197,7 +223,7 @@ sub _pack {
$num < 32 ? CORE::pack( 'C', 0xa0 + $num )
: $num < 2 ** 16 - 1 ? CORE::pack( 'Cn', 0xda, $num )
: $num < 2 ** 32 - 1 ? CORE::pack( 'CN', 0xdb, $num )
- : die "" # don't arrivie here
+ : _unexpected_number($num)
;
return $header . $value;
@@ -207,7 +233,7 @@ sub _pack {
return pack_double( $value );
}
else {
- die "???";
+ _unexpected("data type %s", $b_obj);
}
}
@@ -284,11 +310,11 @@ sub _unpack {
}
elsif ( $byte == 0xcd ) { # uint16
$p += 2;
- return CORE::unpack 'n', substr( $value, $p - 2, 2 );
+ return unpack_uint16( $value, $p - 2 );
}
elsif ( $byte == 0xce ) { # unit32
$p += 4;
- return CORE::unpack 'N', substr( $value, $p - 4, 4 );
+ return unpack_uint32( $value, $p - 4 );
}
elsif ( $byte == 0xcf ) { # unit64
$p += 8;
@@ -351,7 +377,7 @@ sub _unpack {
}
else {
- die "???";
+ _unexpected("byte 0x%02x", $byte);
}
}
@@ -470,7 +496,7 @@ sub _count {
: $byte == 0xcd ? 2
: $byte == 0xce ? 4
: $byte == 0xcf ? 8
- : die;
+ : _unexpected("byte 0x%02x", $byte);
return 1;
}
@@ -479,7 +505,7 @@ sub _count {
: $byte == 0xd1 ? 2
: $byte == 0xd2 ? 4
: $byte == 0xd3 ? 8
- : die;
+ : _unexpected("byte 0x%02x", $byte);
return 1;
}
@@ -510,7 +536,7 @@ sub _count {
}
else {
- die "???";
+ _unexpected("byte 0x%02x", $byte);
}
return 0;
diff --git a/perl/t/00_compile.t b/perl/t/00_compile.t
index f91b29e..d465f8d 100644
--- a/perl/t/00_compile.t
+++ b/perl/t/00_compile.t
@@ -3,4 +3,5 @@ use warnings;
use Test::More tests => 1;
use_ok 'Data::MessagePack';
-diag ( $INC{'Data/MessagePack/PP.pm'} ? 'PP' : 'XS' );
+diag ( "Testing Data::MessagePack/$Data::MessagePack::VERSION (",
+ $INC{'Data/MessagePack/PP.pm'} ? 'PP' : 'XS', ")" );
diff --git a/perl/t/12_stream_unpack3.t b/perl/t/12_stream_unpack4.t
similarity index 88%
rename from perl/t/12_stream_unpack3.t
rename to perl/t/12_stream_unpack4.t
index 118acc3..de76e81 100644
--- a/perl/t/12_stream_unpack3.t
+++ b/perl/t/12_stream_unpack4.t
@@ -9,6 +9,7 @@ my @input = (
[[],[]],
[{"a" => 97},{"a" => 97}],
[{"a" => 97},{"a" => 97},{"a" => 97}],
+ [ map { +{ "foo $_" => "bar $_" } } 'aa' .. 'zz' ],
);
plan tests => @input * 2;
diff --git a/perl/t/50_leaktrace.t b/perl/t/50_leaktrace.t
index 2948527..440ac90 100644
--- a/perl/t/50_leaktrace.t
+++ b/perl/t/50_leaktrace.t
@@ -2,8 +2,12 @@
use strict;
use Test::Requires { 'Test::LeakTrace' => 0.13 };
use Test::More;
-
use Data::MessagePack;
+BEGIN {
+ if($INC{'Data/MessagePack/PP.pm'}) {
+ plan skip_all => 'disabled in PP';
+ }
+}
my $simple_data = "xyz";
my $complex_data = {
diff --git a/perl/t/data.pl b/perl/t/data.pl
index 2f58d38..95eac41 100644
--- a/perl/t/data.pl
+++ b/perl/t/data.pl
@@ -5,14 +5,39 @@ no warnings; # i need this, i need this.
'92 90 91 91 c0', [[], [[undef]]],
'93 c0 c2 c3', [undef, false, true],
'ce 80 00 00 00', 2147483648,
- '99 cc 00 cc 80 cc ff cd 00 00 cd 80 00 cd ff ff ce 00 00 00 00 ce 80 00 00 00 ce ff ff ff ff', [0, 128, 255, 0, 32768, 65535, 0, 2147483648, 4294967295],
+ '99 cc 00 cc 80 cc ff cd 00 00 cd 80 00 cd ff ff ce 00 00 00 00 ce 80 00 00 00 ce ff ff ff ff',
+ [0, 128, 255, 0, 32768, 65535, 0, 2147483648, 4294967295],
'92 93 00 40 7f 93 e0 f0 ff', [[0, 64, 127], [-32, -16, -1]],
- '96 dc 00 00 dc 00 01 c0 dc 00 02 c2 c3 dd 00 00 00 00 dd 00 00 00 01 c0 dd 00 00 00 02 c2 c3', [[], [undef], [false, true], [], [undef], [false, true]],
- '96 da 00 00 da 00 01 61 da 00 02 61 62 db 00 00 00 00 db 00 00 00 01 61 db 00 00 00 02 61 62', ["", "a", "ab", "", "a", "ab"],
- '99 d0 00 d0 80 d0 ff d1 00 00 d1 80 00 d1 ff ff d2 00 00 00 00 d2 80 00 00 00 d2 ff ff ff ff', [0, -128, -1, 0, -32768, -1, 0, -2147483648, -1],
+ '96 dc 00 00 dc 00 01 c0 dc 00 02 c2 c3 dd 00 00 00 00 dd 00 00 00 01 c0 dd 00 00 00 02 c2 c3',
+ [[], [undef], [false, true], [], [undef], [false, true]],
+ '96 da 00 00 da 00 01 61 da 00 02 61 62 db 00 00 00 00 db 00 00 00 01 61 db 00 00 00 02 61 62',
+ ["", "a", "ab", "", "a", "ab"],
+ '99 d0 00 d0 80 d0 ff d1 00 00 d1 80 00 d1 ff ff d2 00 00 00 00 d2 80 00 00 00 d2 ff ff ff ff',
+ [0, -128, -1, 0, -32768, -1, 0, -2147483648, -1],
'82 c2 81 c0 c0 c3 81 c0 80', {false,{undef,undef}, true,{undef,{}}},
- '96 de 00 00 de 00 01 c0 c2 de 00 02 c0 c2 c3 c2 df 00 00 00 00 df 00 00 00 01 c0 c2 df 00 00 00 02 c0 c2 c3 c2', [{}, {undef,false}, {true,false, undef,false}, {}, {undef,false}, {true,false, undef,false}],
+ '96 de 00 00 de 00 01 c0 c2 de 00 02 c0 c2 c3 c2 df 00 00 00 00 df 00 00 00 01 c0 c2 df 00 00 00 02 c0 c2 c3 c2',
+ [{}, {undef,false}, {true,false, undef,false}, {}, {undef,false}, {true,false, undef,false}],
'ce 00 ff ff ff' => ''.0xFFFFFF,
'aa 34 32 39 34 39 36 37 32 39 35' => ''.0xFFFFFFFF,
'ab 36 38 37 31 39 34 37 36 37 33 35' => ''.0xFFFFFFFFF,
+
+ 'd2 80 00 00 01' => '-2147483647', # int32_t
+ 'ce 80 00 00 01' => '2147483649', # uint32_t
+
+ 'd2 ff ff ff ff' => '-1', # int32_t
+ 'ce ff ff ff ff' => '4294967295', # uint32_t
+
+ 'd3 00 00 00 00 80 00 00 01' => '2147483649', # int64_t
+ 'cf 00 00 00 00 80 00 00 01' => '2147483649', # uint64_t
+
+ 'd3 ff 00 ff ff ff ff ff ff' => '-71776119061217281', # int64_t
+ 'cf ff 00 ff ff ff ff ff ff' => '18374967954648334335', # uint64_t
+
+ 'd3 ff ff ff ff ff ff ff ff' => '-1', # int64_t
+ 'cf ff ff ff ff ff ff ff ff' => '18446744073709551615', # uint64_t
+
+ # int64_t
+ 'd3 00 00 00 10 00 00 00 00' => '68719476736',
+ 'd3 00 00 00 10 00 00 00 01' => '68719476737',
+ 'd3 10 00 00 00 00 00 00 00' => '1152921504606846976',
)
diff --git a/perl/xs-src/unpack.c b/perl/xs-src/unpack.c
index e89b22c..20b345f 100644
--- a/perl/xs-src/unpack.c
+++ b/perl/xs-src/unpack.c
@@ -1,5 +1,6 @@
#define NEED_newRV_noinc
#define NEED_sv_2pv_flags
+#define NEED_my_snprintf
#include "xshelper.h"
#define MY_CXT_KEY "Data::MessagePack::_unpack_guts" XS_VERSION
@@ -102,13 +103,6 @@ STATIC_INLINE int template_callback_UV(unpack_user* u PERL_UNUSED_DECL, UV const
return 0;
}
-STATIC_INLINE int template_callback_uint64(unpack_user* u PERL_UNUSED_DECL, uint64_t const d, SV** o)
-{
- dTHX;
- *o = newSVnv((NV)d);
- return 0;
-}
-
STATIC_INLINE int template_callback_IV(unpack_user* u PERL_UNUSED_DECL, IV const d, SV** o)
{
dTHX;
@@ -116,10 +110,21 @@ STATIC_INLINE int template_callback_IV(unpack_user* u PERL_UNUSED_DECL, IV const
return 0;
}
-STATIC_INLINE int template_callback_int64(unpack_user* u PERL_UNUSED_DECL, int64_t const d, SV** o)
+static int template_callback_uint64(unpack_user* u PERL_UNUSED_DECL, uint64_t const d, SV** o)
{
dTHX;
- *o = newSVnv((NV)d);
+ char tbuf[64];
+ STRLEN const len = my_snprintf(tbuf, sizeof(tbuf), "%llu", d);
+ *o = newSVpvn(tbuf, len);
+ return 0;
+}
+
+static int template_callback_int64(unpack_user* u PERL_UNUSED_DECL, int64_t const d, SV** o)
+{
+ dTHX;
+ char tbuf[64];
+ STRLEN const len = my_snprintf(tbuf, sizeof(tbuf), "%lld", d);
+ *o = newSVpvn(tbuf, len);
return 0;
}