X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FStorable%2FStorable.xs;h=5b3868b8f7e35aae95ae13ac138cf3d50908eddc;hb=821bf9a5d89e1fc44be0165540e1f57de5c874e1;hp=1bf09c15b6b487cbb5dcb376e8beea25fc718315;hpb=20bb3f55e73254cd65990282983e87860e6ebfab;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 1bf09c1..5b3868b 100644
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -783,10 +783,21 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0};
 #define STORABLE_BIN_WRITE_MINOR	6
 #endif /* (PATCHLEVEL <= 6) */
 
+#if (PATCHLEVEL < 8 || (PATCHLEVEL == 8 && SUBVERSION < 1))
+#define PL_sv_placeholder PL_sv_undef
+#endif
+
 /*
  * Useful store shortcuts...
  */
 
+/*
+ * Note that if you put more than one mark for storing a particular
+ * type of thing, *and* in the retrieve_foo() function you mark both
+ * the thingy's you get off with SEEN(), you *must* increase the
+ * tagnum with cxt->tagnum++ along with this macro!
+ *     - samv 20Jan04
+ */
 #define PUTMARK(x) 							\
   STMT_START {								\
 	if (!cxt->fio)							\
@@ -1237,13 +1248,13 @@ static void clean_store_context(stcxt_t *cxt)
 	if (cxt->hseen) {
 		hv_iterinit(cxt->hseen);
 		while ((he = hv_iternext(cxt->hseen)))	/* Extra () for -Wall, grr.. */
-			HeVAL(he) = &PL_sv_placeholder;
+			HeVAL(he) = &PL_sv_undef;
 	}
 
 	if (cxt->hclass) {
 		hv_iterinit(cxt->hclass);
 		while ((he = hv_iternext(cxt->hclass)))	/* Extra () for -Wall, grr.. */
-			HeVAL(he) = &PL_sv_placeholder;
+			HeVAL(he) = &PL_sv_undef;
 	}
 
 	/*
@@ -2249,7 +2260,13 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             PUTMARK(flags);
                             TRACEME(("(#%d) key '%s' flags %x %u", i, keyval, flags, *keyval));
                         } else {
-                            assert (flags == 0);
+                            /* This is a workaround for a bug in 5.8.0
+                               that causes the HEK_WASUTF8 flag to be
+                               set on an HEK without the hash being
+                               marked as having key flags. We just
+                               cross our fingers and drop the flag.
+                               AMS 20030901 */
+                            assert (flags == 0 || flags == SHV_K_WASUTF8);
                             TRACEME(("(#%d) key '%s'", i, keyval));
                         }
 			WLEN(keylen);
@@ -2340,7 +2357,13 @@ static int store_hash(stcxt_t *cxt, HV *hv)
                             PUTMARK(flags);
                             TRACEME(("(#%d) key '%s' flags %x", i, key, flags));
                         } else {
-                            assert (flags == 0);
+                            /* This is a workaround for a bug in 5.8.0
+                               that causes the HEK_WASUTF8 flag to be
+                               set on an HEK without the hash being
+                               marked as having key flags. We just
+                               cross our fingers and drop the flag.
+                               AMS 20030901 */
+                            assert (flags == 0 || flags == SHV_K_WASUTF8);
                             TRACEME(("(#%d) key '%s'", i, key));
                         }
                         if (flags & SHV_K_ISSV) {
@@ -2447,6 +2470,7 @@ static int store_code(stcxt_t *cxt, CV *cv)
 	 */
 
 	PUTMARK(SX_CODE);
+	cxt->tagnum++;   /* necessary, as SX_CODE is a SEEN() candidate */
 	TRACEME(("size = %d", len));
 	TRACEME(("code = %s", SvPV_nolen(text)));
 
@@ -4186,10 +4210,11 @@ static SV *retrieve_overloaded(stcxt_t *cxt, char *cname)
 	/*
 	 * Restore overloading magic.
 	 */
-
-	stash = (HV *) SvSTASH (sv);
-	if (!stash || !Gv_AMG(stash))
-		CROAK(("Cannot restore overloading on %s(0x%"UVxf") (package %s)",
+	if (!SvTYPE(sv)
+	    || !(stash = (HV *) SvSTASH (sv))
+	    || !Gv_AMG(stash))
+		CROAK(("Cannot restore overloading on %s(0x%"UVxf
+		       ") (package %s)",
 		       sv_reftype(sv, FALSE),
 		       PTR2UV(sv),
 			   stash ? HvNAME(stash) : "<unknown>"));
@@ -4679,6 +4704,7 @@ static SV *retrieve_sv_no(stcxt_t *cxt, char *cname)
 
 	TRACEME(("retrieve_sv_no"));
 
+	cxt->tagnum--; /* undo the tagnum increment in retrieve_l?scalar */
 	SEEN(sv, cname);
 	return sv;
 }
@@ -4929,7 +4955,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname)
              */
 
 #ifdef HAS_RESTRICTED_HASHES
-            if (hv_store_flags(hv, kbuf, size, sv, 0, flags) == 0)
+            if (hv_store_flags(hv, kbuf, size, sv, 0, store_flags) == 0)
                 return (SV *) 0;
 #else
             if (!(store_flags & HVhek_PLACEHOLD))
@@ -4959,13 +4985,24 @@ static SV *retrieve_code(stcxt_t *cxt, char *cname)
     CROAK(("retrieve_code does not work with perl 5.005 or less\n"));
 #else
 	dSP;
-	int type, count;
+	int type, count, tagnum;
 	SV *cv;
 	SV *sv, *text, *sub;
 
 	TRACEME(("retrieve_code (#%d)", cxt->tagnum));
 
 	/*
+	 *  Insert dummy SV in the aseen array so that we don't screw
+	 *  up the tag numbers.  We would just make the internal
+	 *  scalar an untagged item in the stream, but
+	 *  retrieve_scalar() calls SEEN().  So we just increase the
+	 *  tag number.
+	 */
+	tagnum = cxt->tagnum;
+	sv = newSViv(0);
+	SEEN(sv, cname);
+
+	/*
 	 * Retrieve the source of the code reference
 	 * as a small or large scalar
 	 */
@@ -5007,6 +5044,8 @@ static SV *retrieve_code(stcxt_t *cxt, char *cname)
 			CROAK(("Can't eval, please set $Storable::Eval to a true value"));
 		} else {
 			sv = newSVsv(sub);
+			/* fix up the dummy entry... */
+			av_store(cxt->aseen, tagnum, SvREFCNT_inc(sv));
 			return sv;
 		}
 	}
@@ -5044,8 +5083,9 @@ static SV *retrieve_code(stcxt_t *cxt, char *cname)
 
 	FREETMPS;
 	LEAVE;
+	/* fix up the dummy entry... */
+	av_store(cxt->aseen, tagnum, SvREFCNT_inc(sv));
 
-	SEEN(sv, cname);
 	return sv;
 #endif
 }
@@ -5885,6 +5925,9 @@ BOOT:
     gv_fetchpv("Storable::interwork_56_64bit",   GV_ADDMULTI, SVt_PV);
 #endif
 
+void
+init_perinterp()
+
 int
 pstore(f,obj)
 OutputStream	f