X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FStorable%2FStorable.xs;h=5b3868b8f7e35aae95ae13ac138cf3d50908eddc;hb=821bf9a5d89e1fc44be0165540e1f57de5c874e1;hp=4073f928c2399aa62f3b4a38421a2632fad7c36b;hpb=a3bf621f36e93c14b1d9e7c57c2ce75d1a8b29d4;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index 4073f92..5b3868b 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -12,7 +12,7 @@ #include #include -#ifndef PERL_VERSION +#ifndef PATCHLEVEL # include /* Perl's one, needed since 5.6 */ # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) # include @@ -470,7 +470,7 @@ static stcxt_t *Context_ptr = NULL; if (!mbase) { \ TRACEME(("** allocating mbase of %d bytes", MGROW)); \ New(10003, mbase, MGROW, char); \ - msiz = MGROW; \ + msiz = (STRLEN)MGROW; \ } \ mptr = mbase; \ if (x) \ @@ -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) \ @@ -850,12 +861,12 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; #define STORE_SCALAR(pv, len) STORE_PV_LEN(pv, len, SX_SCALAR, SX_LSCALAR) /* - * Store undef in arrays and hashes without recursing through store(). + * Store &PL_sv_undef in arrays without recursing through store(). */ -#define STORE_UNDEF() \ +#define STORE_SV_UNDEF() \ STMT_START { \ cxt->tagnum++; \ - PUTMARK(SX_UNDEF); \ + PUTMARK(SX_SV_UNDEF); \ } STMT_END /* @@ -1322,7 +1333,8 @@ static void init_retrieve_context(stcxt_t *cxt, int optype, int is_tainted) * new retrieve routines. */ - cxt->hseen = ((cxt->retrieve_vtbl == sv_old_retrieve) ? newHV() : 0); + cxt->hseen = (((void*)cxt->retrieve_vtbl == (void*)sv_old_retrieve) + ? newHV() : 0); cxt->aseen = newAV(); /* Where retrieved objects are kept */ cxt->aclass = newAV(); /* Where seen classnames are kept */ @@ -1960,7 +1972,7 @@ static int store_scalar(stcxt_t *cxt, SV *sv) #else SvIV_please(sv); - if (SvIOK(sv)) { + if (SvIOK_notUV(sv)) { iv = SvIV(sv); goto integer; /* Share code above */ } @@ -2036,7 +2048,7 @@ static int store_array(stcxt_t *cxt, AV *av) sav = av_fetch(av, i, 0); if (!sav) { TRACEME(("(#%d) undef item", i)); - STORE_UNDEF(); + STORE_SV_UNDEF(); continue; } TRACEME(("(#%d) item", i)); @@ -2207,7 +2219,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) = (((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) ? SHV_K_LOCKED : 0); - if (val == &PL_sv_undef) + if (val == &PL_sv_placeholder) flags |= SHV_K_PLACEHOLDER; keyval = SvPV(key, keylen_tmp); @@ -2248,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); @@ -2269,7 +2287,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) /* * Storing in "random" order (in the order the keys are stored - * within the the hash). This is the default and will be faster! + * within the hash). This is the default and will be faster! */ for (i = 0; i < len; i++) { @@ -2303,7 +2321,7 @@ static int store_hash(stcxt_t *cxt, HV *hv) = (((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) ? SHV_K_LOCKED : 0); - if (val == &PL_sv_undef) + if (val == &PL_sv_placeholder) flags |= SHV_K_PLACEHOLDER; hek = HeKEY_hek(he); @@ -2339,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) { @@ -2379,7 +2403,7 @@ static int store_code(stcxt_t *cxt, CV *cv) #else dSP; I32 len; - int ret, count, reallen; + int count, reallen; SV *text, *bdeparse; TRACEME(("store_code (0x%"UVxf")", PTR2UV(cv))); @@ -2446,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))); @@ -2475,6 +2500,7 @@ static int store_code(stcxt_t *cxt, CV *cv) static int store_tied(stcxt_t *cxt, SV *sv) { MAGIC *mg; + SV *obj = NULL; int ret = 0; int svt = SvTYPE(sv); char mtype = 'P'; @@ -2520,7 +2546,9 @@ static int store_tied(stcxt_t *cxt, SV *sv) * accesses on the retrieved object will indeed call the magic methods... */ - if ((ret = store(cxt, mg->mg_obj))) /* Extra () for -Wall, grr... */ + /* [#17040] mg_obj is NULL for scalar self-ties. AMS 20030416 */ + obj = mg->mg_obj ? mg->mg_obj : newSV(0); + if ((ret = store(cxt, obj))) return ret; TRACEME(("ok (tied)")); @@ -4182,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) : "")); @@ -4263,19 +4292,27 @@ static SV *retrieve_tied_hash(stcxt_t *cxt, char *cname) static SV *retrieve_tied_scalar(stcxt_t *cxt, char *cname) { SV *tv; - SV *sv; + SV *sv, *obj = NULL; TRACEME(("retrieve_tied_scalar (#%d)", cxt->tagnum)); tv = NEWSV(10002, 0); SEEN(tv, cname); /* Will return if rv is null */ sv = retrieve(cxt, 0); /* Retrieve */ - if (!sv) + if (!sv) { return (SV *) 0; /* Failed */ + } + else if (SvTYPE(sv) != SVt_NULL) { + obj = sv; + } sv_upgrade(tv, SVt_PVMG); - sv_magic(tv, sv, 'q', Nullch, 0); - SvREFCNT_dec(sv); /* Undo refcnt inc from sv_magic() */ + sv_magic(tv, obj, 'q', Nullch, 0); + + if (obj) { + /* Undo refcnt inc from sv_magic() */ + SvREFCNT_dec(obj); + } TRACEME(("ok (retrieve_tied_scalar at 0x%"UVxf")", PTR2UV(tv))); @@ -4667,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; } @@ -4884,7 +4922,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname) if (flags & SHV_K_PLACEHOLDER) { SvREFCNT_dec (sv); - sv = &PL_sv_undef; + sv = &PL_sv_placeholder; store_flags |= HVhek_PLACEHOLD; } if (flags & SHV_K_UTF8) { @@ -4917,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)) @@ -4947,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, *errsv; + 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 */ @@ -4995,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; } } @@ -5032,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 } @@ -5873,6 +5925,9 @@ BOOT: gv_fetchpv("Storable::interwork_56_64bit", GV_ADDMULTI, SVt_PV); #endif +void +init_perinterp() + int pstore(f,obj) OutputStream f