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
if ( $Data::MessagePack::PreferInteger ) {
@ -242,9 +245,6 @@ sub _pack {
return $header . $value;
}
elsif ( $flags & ( B::SVf_NOK | B::SVp_NOK ) ) { # double only
return pack_double( $value );
}
else {
_unexpected("data type %s", $b_obj);
}

View File

@ -10,14 +10,30 @@ sub packit {
}
sub pis ($$) {
local $Test::Builder::Level = $Test::Builder::Level + 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 = (
0, '00',
(my $foo="0")+0, '00',
{2 => undef}, '81 a1 32 c0',
do {no warnings; my $foo = 10; "$foo"; $foo = undef; $foo} => 'c0', # PVIV but !POK && !IOK
1, '01',
127, '7f',
128, 'cc 80',
@ -33,12 +49,16 @@ my @dat = (
-32768, 'd1 80 00',
-32769, 'd2 ff ff 7f ff',
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',
"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',
"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',
PVIV_but_not_POK_nor_IOK(), 'c0',
Data::MessagePack::true(), 'c3',
Data::MessagePack::false(), 'c2',
[], '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);
SvGETMAGIC(sv);
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 (SvNIOKp(sv)) {
if (SvNIOKp(sv)) {
if(SvUOK(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. */
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)) {
_msgpack_pack_rv(enc, SvRV(sv), depth-1);
} else if (!SvOK(sv)) {
@ -233,9 +233,9 @@ STATIC_INLINE void _msgpack_pack_rv(enc_t *enc, SV* sv, int depth) {
char *pv = svt ? SvPV (sv, len) : 0;
if (len == 1 && *pv == '1')
msgpack_pack_true(enc);
msgpack_pack_true(enc);
else if (len == 1 && *pv == '0')
msgpack_pack_false(enc);
msgpack_pack_false(enc);
else {
//sv_dump(sv);
croak("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",