- fixed SVt_PVNV issue.

perl/Makefile.PL

@@ -23,6 +23,10 @@ makemaker_args(
 tests 't/*.t';
 author_tests('xt');
 
+if ($ENV{DEBUG}) {
+    cc_append_to_ccflags '-g';
+}
+
 # copy modules
 if ($Module::Install::AUTHOR && -d File::Spec->catfile('..', 'msgpack')) {
     mkdir 'msgpack' unless -d 'msgpack';

perl/MessagePack.c

@@ -31,8 +31,6 @@ XS(boot_Data__MessagePack) {
     newXS("Data::MessagePack::pack", xs_pack, __FILE__);
     newXS("Data::MessagePack::unpack", xs_unpack, __FILE__);
     stash = gv_stashpvn("Data::MessagePack", strlen("Data::MessagePack"), TRUE);
-    newCONSTSUB(stash, "true", &PL_sv_yes);
-    newCONSTSUB(stash, "false", &PL_sv_no);
 
     newXS("Data::MessagePack::Unpacker::new",           xs_unpacker_new, __FILE__);
     newXS("Data::MessagePack::Unpacker::execute",       xs_unpacker_execute, __FILE__);

perl/lib/Data/MessagePack.pm

@@ -7,6 +7,11 @@ use 5.008001;
 our $VERSION = '0.07';
 our $PreferInteger = 0;
 
+our $true  = do { bless \(my $dummy = 1), "Data::MessagePack::Boolean" };
+our $false = do { bless \(my $dummy = 0), "Data::MessagePack::Boolean" };
+sub true  () { $true  }
+sub false () { $false }
+
 XSLoader::load(__PACKAGE__, $VERSION);
 
 1;

perl/pack.c

@@ -137,23 +137,71 @@ static int try_int(enc_t* enc, const char *p, size_t len) {
 }
 
 
-static void _msgpack_pack_sv(enc_t *enc, SV* val) {
+static void _msgpack_pack_rv(enc_t *enc, SV* sv);
-    if (val==NULL) {
+
+static void _msgpack_pack_sv(enc_t *enc, SV* sv) {
+    SvGETMAGIC(sv);
+
+    if (sv==NULL) {
         msgpack_pack_nil(enc);
-    } else if (SvROK(val)) {
+    } else if (SvPOKp(sv)) {
-        _msgpack_pack_sv(enc, SvRV(val));
+        STRLEN len;
-    } else if (SVt_PVNV == SvTYPE(val)) {
+        char * csv = SvPV(sv, len);
-        STRLEN len = 0;
+
-        char *pv = SvPV(val, len);
+        if (s_pref_int && try_int(enc, csv, len)) {
-        if (len == 1 && *pv == '1') {
+            return;
-            msgpack_pack_true(enc);
-        } else if (len == 0 && *pv==0) {
-            msgpack_pack_false(enc);
         } else {
-            msgpack_pack_nil(enc);
+            msgpack_pack_raw(enc, len);
+            msgpack_pack_raw_body(enc, csv, len);
         }
-    } else if (SvTYPE(val) == SVt_PVAV) {
+    } else if (SvNOKp(sv)) {
-        AV* ary = (AV*)val;
+        PACK_WRAPPER(NVTYPE)(enc, SvNVX(sv));
+    } else if (SvIOK_UV(sv)) {
+        msgpack_pack_uint32(enc, SvUV(sv));
+    } else if (SvIOKp(sv)) {
+        PACK_WRAPPER(IVTYPE)(enc, SvIV(sv));
+    } else if (SvROK(sv)) {
+        _msgpack_pack_rv(enc, SvRV(sv));
+    } else if (!SvOK(sv)) {
+        msgpack_pack_nil(enc);
+    } else if (isGV(sv)) {
+        Perl_croak(aTHX_ "msgpack cannot pack the GV\n");
+    } else {
+        sv_dump(sv);
+        Perl_croak(aTHX_ "msgpack for perl doesn't supported this type: %d\n", SvTYPE(sv));
+    }
+}
+
+static void _msgpack_pack_rv(enc_t *enc, SV* sv) {
+    svtype svt;
+    SvGETMAGIC(sv);
+    svt = SvTYPE(sv);
+
+    if (SvOBJECT (sv)) {
+        HV *stash = gv_stashpv ("Data::MessagePack::Boolean", 1); // TODO: cache?
+        if (SvSTASH (sv) == stash) {
+            if (SvIV(sv)) {
+                msgpack_pack_true(enc);
+            } else {
+                msgpack_pack_false(enc);
+            }
+        } else {
+            croak ("encountered object '%s', Data::MessagePack doesn't allow the object",
+                           SvPV_nolen(sv_2mortal(newRV_inc(sv))));
+        }
+    } else if (svt == SVt_PVHV) {
+        HV* hval = (HV*)sv;
+        int count = hv_iterinit(hval);
+        HE* he;
+
+        msgpack_pack_map(enc, count);
+
+        while (he = hv_iternext(hval)) {
+            _msgpack_pack_sv(enc, hv_iterkeysv(he));
+            _msgpack_pack_sv(enc, HeVAL(he));
+        }
+    } else if (svt == SVt_PVAV) {
+        AV* ary = (AV*)sv;
         int len = av_len(ary) + 1;
         int i;
         msgpack_pack_array(enc, len);
@@ -165,40 +213,22 @@ static void _msgpack_pack_sv(enc_t *enc, SV* val) {
                 msgpack_pack_nil(enc);
             }
         }
-    } else if (SvTYPE(val) == SVt_PVHV) {
+    } else if (svt < SVt_PVAV) {
-        HV* hval = (HV*)val;
+        STRLEN len = 0;
-        int count = hv_iterinit(hval);
+        char *pv = svt ? SvPV (sv, len) : 0;
-        HE* he;
 
-        msgpack_pack_map(enc, count);
+        if (len == 1 && *pv == '1')
-
+            msgpack_pack_true(enc); 
-        while (he = hv_iternext(hval)) {
+        else if (len == 1 && *pv == '0')
-            _msgpack_pack_sv(enc, hv_iterkeysv(he));
+            msgpack_pack_false(enc); 
-            _msgpack_pack_sv(enc, HeVAL(he));
+        else {
+            sv_dump(sv);
+            croak("cannot encode reference to scalar '%s' unless the scalar is 0 or 1",
+                    SvPV_nolen (sv_2mortal (newRV_inc (sv))));
         }
-    } else if (SvPOKp(val)) {
-        STRLEN len;
-        char * cval = SvPV(val, len);
-
-        if (s_pref_int && try_int(enc, cval, len)) {
-            return;
-        }
-
-        msgpack_pack_raw(enc, len);
-        msgpack_pack_raw_body(enc, cval, len);
-    } else if (SvIOK_UV(val)) {
-        msgpack_pack_uint32(enc, SvUV(val));
-    } else if (SvIOK(val)) {
-        PACK_WRAPPER(IVTYPE)(enc, SvIV(val));
-    } else if (SvNOK(val)) {
-        PACK_WRAPPER(NVTYPE)(enc, SvNV(val));
-    } else if (!SvOK(val)) {
-        msgpack_pack_nil(enc);
-    } else if (isGV(val)) {
-        Perl_croak(aTHX_ "msgpack cannot pack the GV\n");
     } else {
-        sv_dump(val);
+        croak ("encountered %s, but msgpack can only represent references to arrays or hashes",
-        Perl_croak(aTHX_ "msgpack for perl doesn't supported this type: %d\n", SvTYPE(val));
+                   SvPV_nolen (sv_2mortal (newRV_inc (sv))));
     }
 }
 

perl/t/01_pack.t

@@ -33,6 +33,7 @@ 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
     "",    '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',

perl/unpack.c

@@ -5,6 +5,7 @@ extern "C" {
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
+#include "util.h"
 #define NEED_newRV_noinc
 #define NEED_sv_2pv_flags
 #include "ppport.h"
@@ -33,6 +34,21 @@ typedef struct {
 
 #define msgpack_unpack_user unpack_user
 
+/* ---------------------------------------------------------------------- */
+/* utility functions                                                      */
+
+static INLINE SV *
+get_bool (const char *name) {
+    SV * sv = get_sv( name, 1 );
+
+    SvREADONLY_on(sv);
+    SvREADONLY_on( SvRV(sv) );
+
+    return sv;
+}
+
+/* ---------------------------------------------------------------------- */
+
 struct template_context;
 typedef struct template_context msgpack_unpack_t;
 
@@ -43,61 +59,61 @@ static SV* template_data(msgpack_unpack_t* u);
 static int template_execute(msgpack_unpack_t* u,
     const char* data, size_t len, size_t* off);
 
-static inline SV* template_callback_root(unpack_user* u)
+static INLINE SV* template_callback_root(unpack_user* u)
 { return &PL_sv_undef; }
 
-static inline int template_callback_uint8(unpack_user* u, uint8_t d, SV** o)
+static INLINE int template_callback_uint8(unpack_user* u, uint8_t d, SV** o)
 { *o = newSVuv(d); return 0; }
 
-static inline int template_callback_uint16(unpack_user* u, uint16_t d, SV** o)
+static INLINE int template_callback_uint16(unpack_user* u, uint16_t d, SV** o)
 { *o = newSVuv(d); return 0; }
 
-static inline int template_callback_uint32(unpack_user* u, uint32_t d, SV** o)
+static INLINE int template_callback_uint32(unpack_user* u, uint32_t d, SV** o)
 { *o = newSVuv(d); return 0; }
 
-static inline int template_callback_uint64(unpack_user* u, uint64_t d, SV** o)
+static INLINE int template_callback_uint64(unpack_user* u, uint64_t d, SV** o)
 { *o = newSVuv(d); return 0; }
 
-static inline int template_callback_int8(unpack_user* u, int8_t d, SV** o)
+static INLINE int template_callback_int8(unpack_user* u, int8_t d, SV** o)
 { *o = newSViv((long)d); return 0; }
 
-static inline int template_callback_int16(unpack_user* u, int16_t d, SV** o)
+static INLINE int template_callback_int16(unpack_user* u, int16_t d, SV** o)
 { *o = newSViv((long)d); return 0; }
 
-static inline int template_callback_int32(unpack_user* u, int32_t d, SV** o)
+static INLINE int template_callback_int32(unpack_user* u, int32_t d, SV** o)
 { *o = newSViv((long)d); return 0; }
 
-static inline int template_callback_int64(unpack_user* u, int64_t d, SV** o)
+static INLINE int template_callback_int64(unpack_user* u, int64_t d, SV** o)
 { *o = newSViv(d); return 0; }
 
-static inline int template_callback_float(unpack_user* u, float d, SV** o)
+static INLINE int template_callback_float(unpack_user* u, float d, SV** o)
 { *o = newSVnv(d); return 0; }
 
-static inline int template_callback_double(unpack_user* u, double d, SV** o)
+static INLINE int template_callback_double(unpack_user* u, double d, SV** o)
 { *o = newSVnv(d); return 0; }
 
-static inline int template_callback_nil(unpack_user* u, SV** o)
+static INLINE int template_callback_nil(unpack_user* u, SV** o)
 { *o = &PL_sv_undef; return 0; }
 
-static inline int template_callback_true(unpack_user* u, SV** o)
+static INLINE int template_callback_true(unpack_user* u, SV** o)
-{ *o = &PL_sv_yes; return 0; }
+{ *o = get_bool("Data::MessagePack::true") ; return 0; }
 
-static inline int template_callback_false(unpack_user* u, SV** o)
+static INLINE int template_callback_false(unpack_user* u, SV** o)
-{ *o = &PL_sv_no; return 0;}
+{ *o = get_bool("Data::MessagePack::false") ; return 0; }
 
-static inline int template_callback_array(unpack_user* u, unsigned int n, SV** o)
+static INLINE int template_callback_array(unpack_user* u, unsigned int n, SV** o)
 { AV* a = newAV(); *o = (SV*)newRV_noinc((SV*)a); av_extend(a, n); return 0; }
 
-static inline int template_callback_array_item(unpack_user* u, SV** c, SV* o)
+static INLINE int template_callback_array_item(unpack_user* u, SV** c, SV* o)
 { av_push((AV*)SvRV(*c), o); SvREFCNT_inc(o); return 0; }  /* FIXME set value directry RARRAY_PTR(obj)[RARRAY_LEN(obj)++] */
 
-static inline int template_callback_map(unpack_user* u, unsigned int n, SV** o)
+static INLINE int template_callback_map(unpack_user* u, unsigned int n, SV** o)
 { HV * h = newHV(); *o = newRV_noinc((SV*)h); return 0; }
 
-static inline int template_callback_map_item(unpack_user* u, SV** c, SV* k, SV* v)
+static INLINE int template_callback_map_item(unpack_user* u, SV** c, SV* k, SV* v)
 { hv_store_ent((HV*)SvRV(*c), k, v, 0); SvREFCNT_inc(v); return 0; }
 
-static inline int template_callback_raw(unpack_user* u, const char* b, const char* p, unsigned int l, SV** o)
+static INLINE int template_callback_raw(unpack_user* u, const char* b, const char* p, unsigned int l, SV** o)
 { *o = (l == 0) ? newSVpv("", 0) : newSVpv(p, l); return 0; }
 
 #define UNPACKER(from, name) \

perl/util.h

@@ -0,0 +1,11 @@
+#ifndef __PERL_MSGPACK_UTIL_H__
+#define __PERL_MSGPACK_UTIL_H__
+
+#if __GNUC__ >= 3
+# define INLINE                     inline
+#else
+# define INLINE                     
+#endif
+
+#endif // __PERL_MSGPACK_UTIL_H__
+