From 8acabaa135eb7984c016b1f4e1a93cb31e997127 Mon Sep 17 00:00:00 2001 From: "Fuji, Goro" Date: Sun, 7 Aug 2011 18:51:16 +0900 Subject: [PATCH] Revert "SVs with POK and IOK/NOK should be packed as numbers, not strings" This reverts commit 28f4338a6ca40bff9fb0b0e82f121d395978fa5c. --- perl/lib/Data/MessagePack/PP.pm | 6 +++--- perl/t/01_pack.t | 24 ++---------------------- perl/xs-src/pack.c | 26 +++++++++++++------------- 3 files changed, 18 insertions(+), 38 deletions(-) diff --git a/perl/lib/Data/MessagePack/PP.pm b/perl/lib/Data/MessagePack/PP.pm index 74fe8866..f179ad74 100644 --- a/perl/lib/Data/MessagePack/PP.pm +++ b/perl/lib/Data/MessagePack/PP.pm @@ -211,9 +211,6 @@ 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 ) { @@ -245,6 +242,9 @@ 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); } diff --git a/perl/t/01_pack.t b/perl/t/01_pack.t index 8293bbbf..8c619809 100644 --- a/perl/t/01_pack.t +++ b/perl/t/01_pack.t @@ -10,30 +10,14 @@ 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', @@ -49,16 +33,12 @@ my @dat = ( -32768, 'd1 80 00', -32769, 'd2 ff ff 7f ff', 1.0, 'cb 3f f0 00 00 00 00 00 00', - upgrade_to_PVXV( 1), '01', - upgrade_to_PVXV(-1), 'ff', - upgrade_to_PVXV(3.0), 'cb 40 08 00 00 00 00 00 00', + do { my $x=3.0;my $y = "$x";$x }, 'a1 33', # PVNV "", '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', diff --git a/perl/xs-src/pack.c b/perl/xs-src/pack.c index 97ae045c..862808eb 100644 --- a/perl/xs-src/pack.c +++ b/perl/xs-src/pack.c @@ -152,7 +152,17 @@ 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 (SvNIOKp(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(SvUOK(sv)) { PACK_UV(enc, SvUVX(sv)); } @@ -163,16 +173,6 @@ 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",