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

perl/lib/Data/MessagePack/PP.pm

@@ -1,20 +1,17 @@
 package Data::MessagePack::PP;
 use 5.008001;
 use strict;
+use warnings;
+no warnings 'recursion';
+
 use Carp ();
+use B ();
 
 # See also
 # http://redmine.msgpack.org/projects/msgpack/wiki/FormatSpec
 # http://cpansearch.perl.org/src/YAPPO/Data-Model-0.00006/lib/Data/Model/Driver/Memcached.pm
 # http://frox25.no-ip.org/~mtve/wiki/MessagePack.html : reference to using CORE::pack, CORE::unpack
 
-
-package
-    Data::MessagePack;
-
-use strict;
-use B ();
-
 BEGIN {
     my $unpack_int64_slow;
     my $unpack_uint64_slow;
@@ -120,6 +117,18 @@ BEGIN {
         *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 ) ); };
     }
+
+    # fixin package symbols
+    no warnings 'once';
+    sub pack   :method;
+    sub unpack :method;
+    *Data::MessagePack::pack   = \&pack;
+    *Data::MessagePack::unpack = \&unpack;
+
+    @Data::MessagePack::Unpacker::ISA = qw(Data::MessagePack::PP::Unpacker);
+
+    *true  = \&Data::MessagePack::true;
+    *false = \&Data::MessagePack::false;
 }
 
 sub _unexpected {
@@ -130,10 +139,7 @@ sub _unexpected {
 # PACK
 #
 
-{
-    no warnings 'recursion';
-
-    our $_max_depth;
+our $_max_depth;
 
 sub pack :method {
     Carp::croak('Usage: Data::MessagePack->pack($dat [,$max_depth])') if @_ < 2;
@@ -238,20 +244,19 @@ sub _pack {
 
 }
 
-} # PACK
-
-
 #
 # UNPACK
 #
 
-{
-
-    my $p; # position variables for speed.
+my $p; # position variables for speed.
 
 sub unpack :method {
     $p = 0; # init
-    _unpack( $_[1] );
+    my $data = _unpack( $_[1] );
+    if($p < length($_[1])) {
+        Carp::croak("Data::MessagePack->unpack: extra bytes");
+    }
+    return $data;
 }
 
 
@@ -383,17 +388,12 @@ sub _unpack {
 }
 
 
-} # UNPACK
-
-
 #
 # Data::MessagePack::Unpacker
 #
 
 package
-    Data::MessagePack::Unpacker;
-
-use strict;
+    Data::MessagePack::PP::Unpacker;
 
 sub new {
     bless { pos => 0 }, shift;
@@ -404,10 +404,6 @@ sub execute_limit {
     execute( @_ );
 }
 
-
-{
-    my $p;
-
 sub execute {
     my ( $self, $data, $offset, $limit ) = @_;
     $offset ||= 0;
@@ -542,8 +538,6 @@ sub _count {
     return 0;
 }
 
-} # execute
-
 
 sub data {
     return Data::MessagePack->unpack( substr($_[0]->{ data }, 0, $_[0]->{pos}) );

perl/t/13_booleans.t

@@ -0,0 +1,12 @@
+#!perl -w
+use strict;
+use Test::More tests => 6;
+use Data::MessagePack;
+
+ok defined(Data::MessagePack::true()), 'true (1)';
+ok defined(Data::MessagePack::true()), 'true (2)';
+ok Data::MessagePack::true(),          'true is true';
+
+ok defined(Data::MessagePack::false()), 'false (1)';
+ok defined(Data::MessagePack::false()), 'false (2)';
+ok !Data::MessagePack::false(),         'false is false';

perl/t/14_invalid_data.t

@@ -0,0 +1,18 @@
+use strict;
+use warnings;
+use Data::MessagePack;
+use Test::More;
+use t::Util;
+
+my $nil = Data::MessagePack->pack(undef);
+
+my @data = do 't/data.pl';
+while(my($dump, $data) = splice @data, 0, 2) {
+    my $s = Data::MessagePack->pack($data);
+    eval {
+        Data::MessagePack->unpack($s . $nil);
+    };
+    like $@, qr/extra bytes/, "dump $dump";
+}
+
+done_testing;

perl/xs-src/unpack.c

@@ -31,6 +31,7 @@ typedef struct {
 #define msgpack_unpack_user unpack_user
 
 void init_Data__MessagePack_unpack(pTHX_ bool const cloning) {
+    // booleans are load on demand (lazy load).
     if(!cloning) {
         MY_CXT_INIT;
         MY_CXT.msgpack_true  = NULL;
@@ -52,11 +53,17 @@ static SV*
 load_bool(pTHX_ const char* const name) {
     CV* const cv = get_cv(name, GV_ADD);
     dSP;
+    ENTER;
+    SAVETMPS;
     PUSHMARK(SP);
     call_sv((SV*)cv, G_SCALAR);
     SPAGAIN;
     SV* const sv = newSVsv(POPs);
     PUTBACK;
+    FREETMPS;
+    LEAVE;
+    assert(sv);
+    assert(sv_isobject(sv));
     return sv;
 }