generic-library/msgpack
1
0
Fork 0
mirror of https://github.com/msgpack/msgpack-c.git synced 2025-10-21 15:51:44 +02:00
Code Issues Projects Releases Wiki Activity

perl: fix int64_t unpacking in both XS and PP

Browse Source
This commit is contained in:
gfx
2010-09-18 14:30:08 +09:00
parent 1f07721ec4
commit c707392a5a
3 changed files with 89 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
perl/lib/Data/MessagePack/PP.pm
View File

@@ -16,12 +16,44 @@ 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 = Math::BigInt->new( unpack_int32( $_[0], $_[1]) );
my $low = Math::BigInt->new( unpack_uint32( $_[0], $_[1] + 4) );
return +($high << 32 | $low)->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 {
@@ -46,20 +78,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] ) );
};
@@ -71,17 +94,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 {
@@ -93,8 +107,9 @@ 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 ) ); };
}
}
@@ -283,11 +298,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;