This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Storable.xs: Add comments to store_scalar concerning utf8
[perl5.git] / dist / Storable / Storable.xs
index ca6f9b4..65428ad 100644 (file)
@@ -17,7 +17,7 @@
 #include <patchlevel.h>                /* Perl's one, needed since 5.6 */
 #endif
 
-#if !defined(PERL_VERSION) || PERL_VERSION < 8 || (PERL_VERSION == 8 && PERL_SUBVERSION < 9) || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
+#if !defined(PERL_VERSION) || PERL_VERSION < 10 || (PERL_VERSION == 10 && PERL_SUBVERSION < 1)
 #define NEED_load_module
 #define NEED_vload_module
 #define NEED_newCONSTSUB
@@ -1040,6 +1040,12 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 static int store(pTHX_ stcxt_t *cxt, SV *sv);
 static SV *retrieve(pTHX_ stcxt_t *cxt, const char *cname);
 
+#define UNSEE()                             \
+  STMT_START {                              \
+    av_pop(cxt->aseen);                     \
+    cxt->tagnum--;                          \
+  } STMT_END
+
 /*
  * Dynamic dispatching table for SV store.
  */
@@ -1932,6 +1938,7 @@ static int store_ref(pTHX_ stcxt_t *cxt, SV *sv)
  * Store a scalar.
  *
  * Layout is SX_LSCALAR <length> <data>, SX_SCALAR <length> <data> or SX_UNDEF.
+ * SX_LUTF8STR and SX_UTF8STR are used for UTF-8 strings.
  * The <data> section is omitted if <length> is 0.
  *
  * If integer or double, the layout is SX_INTEGER <data> or SX_DOUBLE <data>.
@@ -2854,6 +2861,7 @@ static int store_hook(
         */
 
        switch (type) {
+        case svis_REF:
        case svis_SCALAR:
                obj_type = SHT_SCALAR;
                break;
@@ -2916,9 +2924,8 @@ static int store_hook(
 
        TRACEME(("about to call STORABLE_freeze on class %s", classname));
 
-       ref = newRV_noinc(sv);                          /* Temporary reference */
+       ref = newRV_inc(sv);                            /* Temporary reference */
        av = array_call(aTHX_ ref, hook, clone);        /* @a = $object->STORABLE_freeze($c) */
-       SvRV_set(ref, NULL);
        SvREFCNT_dec(ref);                                      /* Reclaim temporary reference */
 
        count = AvFILLp(av) + 1;
@@ -4216,8 +4223,12 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname)
            attached = scalar_call(aTHX_ rv, attach_hook, clone, av, G_SCALAR);
            if (attached &&
                SvROK(attached) && 
-               sv_derived_from(attached, classname))
+               sv_derived_from(attached, classname)
+        ) {
+               UNSEE();
+               SEEN(SvRV(attached), 0, 0);
                return SvRV(attached);
+        }
            CROAK(("STORABLE_attach did not return a %s object", classname));
        }
 
@@ -5097,7 +5108,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
        SEEN(hv, cname, 0);             /* Will return if table not allocated properly */
        if (len == 0)
                return (SV *) hv;       /* No data follow if table empty */
-       hv_ksplit(hv, len);             /* pre-extend hash to save multiple splits */
+       hv_ksplit(hv, len + 1);         /* pre-extend hash to save multiple splits */
 
        /*
         * Now get each key/value pair in turn...
@@ -5184,7 +5195,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname)
     SEEN(hv, cname, 0);                /* Will return if table not allocated properly */
     if (len == 0)
         return (SV *) hv;      /* No data follow if table empty */
-    hv_ksplit(hv, len);                /* pre-extend hash to save multiple splits */
+    hv_ksplit(hv, len + 1);            /* pre-extend hash to save multiple splits */
 
     /*
      * Now get each key/value pair in turn...
@@ -5503,7 +5514,7 @@ static SV *old_retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname)
        SEEN(hv, 0, 0);                 /* Will return if table not allocated properly */
        if (len == 0)
                return (SV *) hv;       /* No data follow if table empty */
-       hv_ksplit(hv, len);             /* pre-extend hash to save multiple splits */
+       hv_ksplit(hv, len + 1);         /* pre-extend hash to save multiple splits */
 
        /*
         * Now get each key/value pair in turn...