From 4db90d23ac95592ea3892513026de326926007f9 Mon Sep 17 00:00:00 2001
From: Tokuhiro Matsuno <tokuhirom@gmail.com>
Date: Thu, 30 Jul 2009 16:22:00 +0900
Subject: - fixed SVt_PVNV issue.

---
 perl/Makefile.PL             |   4 ++
 perl/MessagePack.c           |   2 -
 perl/lib/Data/MessagePack.pm |   5 ++
 perl/pack.c                  | 120 +++++++++++++++++++++++++++----------------
 perl/t/01_pack.t             |   1 +
 perl/unpack.c                |  58 +++++++++++++--------
 perl/util.h                  |  11 ++++
 7 files changed, 133 insertions(+), 68 deletions(-)
 create mode 100644 perl/util.h

diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index 773d65d..d1bff06 100644
--- a/perl/Makefile.PL
+++ b/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';
diff --git a/perl/MessagePack.c b/perl/MessagePack.c
index 6b9010c..fd1b344 100644
--- a/perl/MessagePack.c
+++ b/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__);
diff --git a/perl/lib/Data/MessagePack.pm b/perl/lib/Data/MessagePack.pm
index f01a92a..38431eb 100644
--- a/perl/lib/Data/MessagePack.pm
+++ b/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;
diff --git a/perl/pack.c b/perl/pack.c
index 50b82e5..01dd5b6 100644
--- a/perl/pack.c
+++ b/perl/pack.c
@@ -137,36 +137,60 @@ static int try_int(enc_t* enc, const char *p, size_t len) {
 }
 
 
-static void _msgpack_pack_sv(enc_t *enc, SV* val) {
-    if (val==NULL) {
+static void _msgpack_pack_rv(enc_t *enc, SV* sv);
+
+static void _msgpack_pack_sv(enc_t *enc, SV* sv) {
+    SvGETMAGIC(sv);
+
+    if (sv==NULL) {
         msgpack_pack_nil(enc);
-    } else if (SvROK(val)) {
-        _msgpack_pack_sv(enc, SvRV(val));
-    } else if (SVt_PVNV == SvTYPE(val)) {
-        STRLEN len = 0;
-        char *pv = SvPV(val, len);
-        if (len == 1 && *pv == '1') {
-            msgpack_pack_true(enc);
-        } else if (len == 0 && *pv==0) {
-            msgpack_pack_false(enc);
+    } else if (SvPOKp(sv)) {
+        STRLEN len;
+        char * csv = SvPV(sv, len);
+
+        if (s_pref_int && try_int(enc, csv, len)) {
+            return;
         } else {
-            msgpack_pack_nil(enc);
+            msgpack_pack_raw(enc, len);
+            msgpack_pack_raw_body(enc, csv, len);
         }
-    } else if (SvTYPE(val) == SVt_PVAV) {
-        AV* ary = (AV*)val;
-        int len = av_len(ary) + 1;
-        int i;
-        msgpack_pack_array(enc, len);
-        for (i=0; i<len; i++) {
-            SV** svp = av_fetch(ary, i, 0);
-            if (svp) {
-                _msgpack_pack_sv(enc, *svp);
+    } else if (SvNOKp(sv)) {
+        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_nil(enc);
+                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 (SvTYPE(val) == SVt_PVHV) {
-        HV* hval = (HV*)val;
+    } else if (svt == SVt_PVHV) {
+        HV* hval = (HV*)sv;
         int count = hv_iterinit(hval);
         HE* he;
 
@@ -176,29 +200,35 @@ static void _msgpack_pack_sv(enc_t *enc, SV* val) {
             _msgpack_pack_sv(enc, hv_iterkeysv(he));
             _msgpack_pack_sv(enc, HeVAL(he));
         }
-    } else if (SvPOKp(val)) {
-        STRLEN len;
-        char * cval = SvPV(val, len);
-
-        if (s_pref_int && try_int(enc, cval, len)) {
-            return;
+    } else if (svt == SVt_PVAV) {
+        AV* ary = (AV*)sv;
+        int len = av_len(ary) + 1;
+        int i;
+        msgpack_pack_array(enc, len);
+        for (i=0; i<len; i++) {
+            SV** svp = av_fetch(ary, i, 0);
+            if (svp) {
+                _msgpack_pack_sv(enc, *svp);
+            } else {
+                msgpack_pack_nil(enc);
+            }
+        }
+    } else if (svt < SVt_PVAV) {
+        STRLEN len = 0;
+        char *pv = svt ? SvPV (sv, len) : 0;
+
+        if (len == 1 && *pv == '1')
+            msgpack_pack_true(enc); 
+        else if (len == 1 && *pv == '0')
+            msgpack_pack_false(enc); 
+        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))));
         }
-
-        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);
-        Perl_croak(aTHX_ "msgpack for perl doesn't supported this type: %d\n", SvTYPE(val));
+        croak ("encountered %s, but msgpack can only represent references to arrays or hashes",
+                   SvPV_nolen (sv_2mortal (newRV_inc (sv))));
     }
 }
 
diff --git a/perl/t/01_pack.t b/perl/t/01_pack.t
index 22a8c14..50fd663 100644
--- a/perl/t/01_pack.t
+++ b/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',
diff --git a/perl/unpack.c b/perl/unpack.c
index 5a28fef..7a4f422 100644
--- a/perl/unpack.c
+++ b/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)
-{ *o = &PL_sv_yes; return 0; }
+static INLINE int template_callback_true(unpack_user* u, SV** o)
+{ *o = get_bool("Data::MessagePack::true") ; return 0; }
 
-static inline int template_callback_false(unpack_user* u, SV** o)
-{ *o = &PL_sv_no; return 0;}
+static INLINE int template_callback_false(unpack_user* u, SV** o)
+{ *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) \
diff --git a/perl/util.h b/perl/util.h
new file mode 100644
index 0000000..2b4ed07
--- /dev/null
+++ b/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__
+
-- 
cgit v1.2.1