SVs with POK and IOK/NOK should be packed as numbers, not strings

This commit is contained in:
Fuji, Goro 2011-08-07 18:36:50 +09:00
parent 800a93a859
commit 28f4338a6c
3 changed files with 38 additions and 18 deletions

View File

@ -211,6 +211,9 @@ sub _pack {
} }
} }
elsif ( $flags & ( B::SVf_NOK | B::SVp_NOK ) ) { # double only
return pack_double( $value );
}
elsif ( $flags & B::SVf_POK ) { # raw / check needs before dboule elsif ( $flags & B::SVf_POK ) { # raw / check needs before dboule
if ( $Data::MessagePack::PreferInteger ) { if ( $Data::MessagePack::PreferInteger ) {
@ -242,9 +245,6 @@ sub _pack {
return $header . $value; return $header . $value;
} }
elsif ( $flags & ( B::SVf_NOK | B::SVp_NOK ) ) { # double only
return pack_double( $value );
}
else { else {
_unexpected("data type %s", $b_obj); _unexpected("data type %s", $b_obj);
} }

View File

@ -10,14 +10,30 @@ sub packit {
} }
sub pis ($$) { sub pis ($$) {
local $Test::Builder::Level = $Test::Builder::Level + 1;
is packit($_[0]), $_[1], 'dump ' . $_[1]; is packit($_[0]), $_[1], 'dump ' . $_[1];
} }
sub PVIV_but_not_POK_nor_IOK {
no warnings 'void';
my $foo = 42;
"$foo"; # upgrade to PVIV
$foo = undef;
return $foo;
}
sub upgrade_to_PVXV {
my($n) = @_;
no warnings 'void';
"$n";
return $n;
}
my @dat = ( my @dat = (
0, '00', 0, '00',
(my $foo="0")+0, '00', (my $foo="0")+0, '00',
{2 => undef}, '81 a1 32 c0', {2 => undef}, '81 a1 32 c0',
do {no warnings; my $foo = 10; "$foo"; $foo = undef; $foo} => 'c0', # PVIV but !POK && !IOK
1, '01', 1, '01',
127, '7f', 127, '7f',
128, 'cc 80', 128, 'cc 80',
@ -33,12 +49,16 @@ my @dat = (
-32768, 'd1 80 00', -32768, 'd1 80 00',
-32769, 'd2 ff ff 7f ff', -32769, 'd2 ff ff 7f ff',
1.0, 'cb 3f f0 00 00 00 00 00 00', 1.0, 'cb 3f f0 00 00 00 00 00 00',
do { my $x=3.0;my $y = "$x";$x }, 'a1 33', # PVNV upgrade_to_PVXV( 1), '01',
upgrade_to_PVXV(-1), 'ff',
upgrade_to_PVXV(3.0), 'cb 40 08 00 00 00 00 00 00',
"", 'a0', "", 'a0',
"a", 'a1 61', "a", 'a1 61',
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", 'bf 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61', "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", 'bf 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61',
"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", 'da 00 20 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61', "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa", 'da 00 20 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61 61',
undef, 'c0', undef, 'c0',
PVIV_but_not_POK_nor_IOK(), 'c0',
Data::MessagePack::true(), 'c3', Data::MessagePack::true(), 'c3',
Data::MessagePack::false(), 'c2', Data::MessagePack::false(), 'c2',
[], '90', [], '90',

View File

@ -152,17 +152,7 @@ STATIC_INLINE void _msgpack_pack_sv(enc_t* const enc, SV* const sv, int const de
if (UNLIKELY(depth <= 0)) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED); if (UNLIKELY(depth <= 0)) Perl_croak(aTHX_ ERR_NESTING_EXCEEDED);
SvGETMAGIC(sv); SvGETMAGIC(sv);
if (SvPOKp(sv)) { if (SvNIOKp(sv)) {
STRLEN const len = SvCUR(sv);
const char* const pv = SvPVX_const(sv);
if (s_pref_int && try_int(enc, pv, len)) {
return;
} else {
msgpack_pack_raw(enc, len);
msgpack_pack_raw_body(enc, pv, len);
}
} else if (SvNIOKp(sv)) {
if(SvUOK(sv)) { if(SvUOK(sv)) {
PACK_UV(enc, SvUVX(sv)); PACK_UV(enc, SvUVX(sv));
} }
@ -173,6 +163,16 @@ STATIC_INLINE void _msgpack_pack_sv(enc_t* const enc, SV* const sv, int const de
/* XXX long double is not supported yet. */ /* XXX long double is not supported yet. */
msgpack_pack_double(enc, (double)SvNVX(sv)); msgpack_pack_double(enc, (double)SvNVX(sv));
} }
} else if (SvPOKp(sv)) {
STRLEN const len = SvCUR(sv);
const char* const pv = SvPVX_const(sv);
if (s_pref_int && try_int(enc, pv, len)) {
return;
} else {
msgpack_pack_raw(enc, len);
msgpack_pack_raw_body(enc, pv, len);
}
} else if (SvROK(sv)) { } else if (SvROK(sv)) {
_msgpack_pack_rv(enc, SvRV(sv), depth-1); _msgpack_pack_rv(enc, SvRV(sv), depth-1);
} else if (!SvOK(sv)) { } else if (!SvOK(sv)) {