Merge branch 'master' of github.com:msgpack/msgpack

2025-10-27 11:06:51 +01:00 · 2010-09-19 15:41:46 +09:00
parent f2a64ed685 afefbe4e56
commit 6bb8b4c994
15 changed files with 181 additions and 91 deletions
--- a/perl/.gitignore
+++ b/perl/.gitignore
@@ -1,4 +1,5 @@
 META.yml
+MYMETA.yml
 Makefile
 Makefile.old
 MessagePack.bs
--- 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

--- a/perl/MANIFEST.SKIP
+++ b/perl/MANIFEST.SKIP
@@ -2,6 +2,7 @@
 \bCVS\b
 ^MANIFEST\.
 ^Makefile$
+^MYMETA\.yml$
 ~$
 ^#
 \.old$
--- 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;
--- 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
    <http://msgpack.org/> is the official web site for the MessagePack
    format.

+    Data::MessagePack::Unpacker
+
+    AnyEvent::MPRPC
+
--- a/perl/benchmark/data.pl
+++ 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 ],
+};
--- 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) },
    }
--- 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) },
    }
--- 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<your> 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<Math::BigInt>.
+
 =head1 TODO

 =over
@@ -187,4 +198,8 @@ it under the same terms as Perl itself.

 L<http://msgpack.org/> is the official web site for the  MessagePack format.

+L<Data::MessagePack::Unpacker>
+
+L<AnyEvent::MPRPC>
+
 =cut
--- 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;
--- 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', ")" );
--- a/perl/t/12_stream_unpack4.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;
--- 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 = {
--- 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',
 )
--- 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;
 }