bump Storage version to 2.20 to distinguish it from the 2.19 that was

[p5sagit/p5-mst-13.2.git] / ext / Storable / Storable.xs

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index d3c0fab..2741c7d 100644 (file)
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -20,6 +20,7 @@
 #if !defined(PERL_VERSION) || PERL_VERSION < 8
 #define NEED_load_module
 #define NEED_vload_module
+#define NEED_newCONSTSUB
 #include "ppport.h"             /* handle old perls */
 #endif
 
@@ -150,7 +151,7 @@ typedef double NV;                  /* Older perls lack the NV type */
 
 #define TRACEME(x)                                                                             \
   STMT_START {                                                                                 \
-       if (SvTRUE(perl_get_sv("Storable::DEBUGME", TRUE)))     \
+       if (SvTRUE(perl_get_sv("Storable::DEBUGME", GV_ADD)))   \
                { PerlIO_stdoutf x; PerlIO_stdoutf("\n"); }             \
   } STMT_END
 #else
@@ -400,7 +401,7 @@ typedef struct stcxt {
 
 #if (PATCHLEVEL <= 4) && (SUBVERSION < 68)
 #define dSTCXT_SV                                                                      \
-       SV *perinterp_sv = perl_get_sv(MY_VERSION, FALSE)
+       SV *perinterp_sv = perl_get_sv(MY_VERSION, 0)
 #else  /* >= perl5.004_68 */
 #define dSTCXT_SV                                                                      \
        SV *perinterp_sv = *hv_fetch(PL_modglobal,              \
@@ -1681,7 +1682,7 @@ static SV *pkg_fetchmeth(
         pTHX_
        HV *cache,
        HV *pkg,
-       char *method)
+       const char *method)
 {
        GV *gv;
        SV *sv;
@@ -1721,7 +1722,7 @@ static void pkg_hide(
         pTHX_
        HV *cache,
        HV *pkg,
-       char *method)
+       const char *method)
 {
        const char *hvname = HvNAME_get(pkg);
        (void) hv_store(cache,
@@ -1737,7 +1738,7 @@ static void pkg_uncache(
         pTHX_
        HV *cache,
        HV *pkg,
-       char *method)
+       const char *method)
 {
        const char *hvname = HvNAME_get(pkg);
        (void) hv_delete(cache, hvname, strlen(hvname), G_DISCARD);
@@ -1755,7 +1756,7 @@ static SV *pkg_can(
         pTHX_
        HV *cache,
        HV *pkg,
-       char *method)
+       const char *method)
 {
        SV **svh;
        SV *sv;
@@ -2331,7 +2332,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
        if (
                !(cxt->optype & ST_CLONE) && (cxt->canonical == 1 ||
                (cxt->canonical < 0 && (cxt->canonical =
-                       (SvTRUE(perl_get_sv("Storable::canonical", TRUE)) ? 1 : 0))))
+                       (SvTRUE(perl_get_sv("Storable::canonical", GV_ADD)) ? 1 : 0))))
        ) {
                /*
                 * Storing in order, sorted by key.
@@ -2618,7 +2619,7 @@ static int store_code(pTHX_ stcxt_t *cxt, CV *cv)
        if (
                cxt->deparse == 0 ||
                (cxt->deparse < 0 && !(cxt->deparse =
-                       SvTRUE(perl_get_sv("Storable::Deparse", TRUE)) ? 1 : 0))
+                       SvTRUE(perl_get_sv("Storable::Deparse", GV_ADD)) ? 1 : 0))
        ) {
                return store_other(aTHX_ cxt, (SV*)cv);
        }
@@ -3396,7 +3397,7 @@ static int store_other(pTHX_ stcxt_t *cxt, SV *sv)
        if (
                cxt->forgive_me == 0 ||
                (cxt->forgive_me < 0 && !(cxt->forgive_me =
-                       SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 : 0))
+                       SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1 : 0))
        )
                CROAK(("Can't store %s items", sv_reftype(sv, FALSE)));
 
@@ -3433,7 +3434,9 @@ static int sv_type(pTHX_ SV *sv)
 {
        switch (SvTYPE(sv)) {
        case SVt_NULL:
+#if PERL_VERSION <= 10
        case SVt_IV:
+#endif
        case SVt_NV:
                /*
                 * No need to check for ROK, that can't be set here since there
@@ -3441,7 +3444,11 @@ static int sv_type(pTHX_ SV *sv)
                 */
                return svis_SCALAR;
        case SVt_PV:
+#if PERL_VERSION <= 10
        case SVt_RV:
+#else
+       case SVt_IV:
+#endif
        case SVt_PVIV:
        case SVt_PVNV:
                /*
@@ -3682,7 +3689,7 @@ static int magic_write(pTHX_ stcxt_t *cxt)
         length = sizeof (network_file_header);
     } else {
 #ifdef USE_56_INTERWORK_KLUDGE
-        if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+        if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
             header = file_header_56;
             length = sizeof (file_header_56);
         } else
@@ -4443,7 +4450,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
         * into the existing design.  -- RAM, 17/02/2001
         */
 
-       sv_magic(sv, rv, mtype, Nullch, 0);
+       sv_magic(sv, rv, mtype, (char *)NULL, 0);
        SvREFCNT_dec(rv);                       /* Undo refcnt inc from sv_magic() */
 
        return sv;
@@ -4496,7 +4503,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname)
 
        if (cname) {
                /* No need to do anything, as rv will already be PVMG.  */
-               assert (SvTYPE(rv) >= SVt_RV);
+               assert (SvTYPE(rv) == SVt_RV || SvTYPE(rv) >= SVt_PV);
        } else {
                sv_upgrade(rv, SVt_RV);
        }
@@ -4560,7 +4567,7 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname)
         * WARNING: breaks RV encapsulation.
         */
 
-       sv_upgrade(rv, SVt_RV);
+       SvUPGRADE(rv, SVt_RV);
        SvRV_set(rv, sv);                               /* $rv = \$sv */
        SvROK_on(rv);
 
@@ -4640,7 +4647,7 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname)
 
        sv_upgrade(tv, SVt_PVAV);
        AvREAL_off((AV *)tv);
-       sv_magic(tv, sv, 'P', Nullch, 0);
+       sv_magic(tv, sv, 'P', (char *)NULL, 0);
        SvREFCNT_dec(sv);                       /* Undo refcnt inc from sv_magic() */
 
        TRACEME(("ok (retrieve_tied_array at 0x%"UVxf")", PTR2UV(tv)));
@@ -4668,7 +4675,7 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname)
                return (SV *) 0;                /* Failed */
 
        sv_upgrade(tv, SVt_PVHV);
-       sv_magic(tv, sv, 'P', Nullch, 0);
+       sv_magic(tv, sv, 'P', (char *)NULL, 0);
        SvREFCNT_dec(sv);                       /* Undo refcnt inc from sv_magic() */
 
        TRACEME(("ok (retrieve_tied_hash at 0x%"UVxf")", PTR2UV(tv)));
@@ -4700,7 +4707,7 @@ static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname)
        }
 
        sv_upgrade(tv, SVt_PVMG);
-       sv_magic(tv, obj, 'q', Nullch, 0);
+       sv_magic(tv, obj, 'q', (char *)NULL, 0);
 
        if (obj) {
                /* Undo refcnt inc from sv_magic() */
@@ -4767,7 +4774,7 @@ static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname)
        RLEN(idx);                                      /* Retrieve <idx> */
 
        sv_upgrade(tv, SVt_PVMG);
-       sv_magic(tv, sv, 'p', Nullch, idx);
+       sv_magic(tv, sv, 'p', (char *)NULL, idx);
        SvREFCNT_dec(sv);                       /* Undo refcnt inc from sv_magic() */
 
        return tv;
@@ -4906,7 +4913,7 @@ static SV *retrieve_utf8str(pTHX_ stcxt_t *cxt, const char *cname)
 #else
         if (cxt->use_bytes < 0)
             cxt->use_bytes
-                = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+                = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
                    ? 1 : 0);
         if (cxt->use_bytes == 0)
             UTF8_CROAK();
@@ -4935,7 +4942,7 @@ static SV *retrieve_lutf8str(pTHX_ stcxt_t *cxt, const char *cname)
 #else
         if (cxt->use_bytes < 0)
             cxt->use_bytes
-                = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+                = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
                    ? 1 : 0);
         if (cxt->use_bytes == 0)
             UTF8_CROAK();
@@ -5266,7 +5273,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
     if (hash_flags & SHV_RESTRICTED) {
         if (cxt->derestrict < 0)
             cxt->derestrict
-                = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", TRUE))
+                = (SvTRUE(perl_get_sv("Storable::downgrade_restricted", GV_ADD))
                    ? 1 : 0);
         if (cxt->derestrict == 0)
             RESTRICTED_HASH_CROAK();
@@ -5335,7 +5342,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
 #else
                 if (cxt->use_bytes < 0)
                     cxt->use_bytes
-                        = (SvTRUE(perl_get_sv("Storable::drop_utf8", TRUE))
+                        = (SvTRUE(perl_get_sv("Storable::drop_utf8", GV_ADD))
                            ? 1 : 0);
                 if (cxt->use_bytes == 0)
                     UTF8_CROAK();
@@ -5436,14 +5443,14 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
         */
 
        if (cxt->eval == NULL) {
-               cxt->eval = perl_get_sv("Storable::Eval", TRUE);
+               cxt->eval = perl_get_sv("Storable::Eval", GV_ADD);
                SvREFCNT_inc(cxt->eval);
        }
        if (!SvTRUE(cxt->eval)) {
                if (
                        cxt->forgive_me == 0 ||
                        (cxt->forgive_me < 0 && !(cxt->forgive_me =
-                               SvTRUE(perl_get_sv("Storable::forgive_me", TRUE)) ? 1 : 0))
+                               SvTRUE(perl_get_sv("Storable::forgive_me", GV_ADD)) ? 1 : 0))
                ) {
                        CROAK(("Can't eval, please set $Storable::Eval to a true value"));
                } else {
@@ -5458,7 +5465,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname)
        SAVETMPS;
 
        if (SvROK(cxt->eval) && SvTYPE(SvRV(cxt->eval)) == SVt_PVCV) {
-               SV* errsv = get_sv("@", TRUE);
+               SV* errsv = get_sv("@", GV_ADD);
                sv_setpvn(errsv, "", 0);        /* clear $@ */
                PUSHMARK(sp);
                XPUSHs(sv_2mortal(newSVsv(sub)));
@@ -5770,7 +5777,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
             if (cxt->accept_future_minor < 0)
                 cxt->accept_future_minor
                     = (SvTRUE(perl_get_sv("Storable::accept_future_minor",
-                                          TRUE))
+                                          GV_ADD))
                        ? 1 : 0);
             if (cxt->accept_future_minor == 1)
                 croak_now = 0;  /* Don't croak yet.  */
@@ -5807,7 +5814,7 @@ static SV *magic_check(pTHX_ stcxt_t *cxt)
 #ifdef USE_56_INTERWORK_KLUDGE
     /* No point in caching this in the context as we only need it once per
        retrieve, and we need to recheck it each read.  */
-    if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", TRUE))) {
+    if (SvTRUE(perl_get_sv("Storable::interwork_56_64bit", GV_ADD))) {
         if ((c != (sizeof (byteorderstr_56) - 1))
             || memNE(buf, byteorderstr_56, c))
             CROAK(("Byte order is not compatible"));
@@ -5941,7 +5948,7 @@ static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname)
             if (cxt->accept_future_minor < 0)
                 cxt->accept_future_minor
                     = (SvTRUE(perl_get_sv("Storable::accept_future_minor",
-                                          TRUE))
+                                          GV_ADD))
                        ? 1 : 0);
             if (cxt->accept_future_minor == 1) {
                 CROAK(("Storable binary image v%d.%d contains data of type %d. "