In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ab5c89ab2dff2722db40c991ab772b028f2b4ed8?hp=cae9253374c944e001366e50bf6332764c5efeff>
- Log ----------------------------------------------------------------- commit ab5c89ab2dff2722db40c991ab772b028f2b4ed8 Merge: cae9253 f5690dd Author: Tony Cook <[email protected]> Date: Wed Jul 24 16:00:45 2013 +1000 [perl #118907] Do not call DESTROY on empty objects with STORABLE_attach avoids creating temporary objects for STORABLE_attach when they aren't needed. commit f5690dd33b1310d207d83e01b6fdb8da423887de Author: Tony Cook <[email protected]> Date: Wed Jul 24 15:58:46 2013 +1000 [perl #118907] bump $Storable::VERSION M dist/Storable/Storable.pm commit f4632cecdf704cb1c4c4df67e1071c3b957d7e36 Author: Tony Cook <[email protected]> Date: Mon Jul 15 14:17:25 2013 +1000 [perl #118907] fix some issues with patch M MANIFEST M dist/Storable/Storable.xs commit 591596833b093b3ccc1a21ffd39c5a416591b91c Author: Vladimir Timofeev <[email protected]> Date: Sat Jul 13 00:40:23 2013 +0400 Restore Storable speed after previous fix. Pull out getting stash by name from macro BLESS and SEEN. So results of gv_stashpv may be reused by calling side. This allow to not evaluate same things twice in retrieve_hook. M dist/Storable/Storable.xs commit 66f7f9034bca27f5c430d2c2eb77d2ac13e50481 Author: Vladimir Timofeev <[email protected]> Date: Fri Jul 12 03:14:19 2013 +0400 Do not call DESTROY for empty objects Before this fix, deserialization process for object with STORABLE_attach hook looks like: 1. create SV of needed type 2. lookup classname 3. bless SV to class 4. lookup for STORABLE_attach 5. destroy SV 6. return result of STORABLE_attach call As a result DESTROY method of target class was called with empty, not initialized object. This behaviour very bad especially for non hash-based XS objects. Fix it, by move blessing temprorary SV after STORABLE_attach hook check. This commit slowdown deserialization of other objects (with STORABLE_thaw hook). It will be fixed later. M dist/Storable/Storable.xs A dist/Storable/t/attach.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + dist/Storable/Storable.pm | 2 +- dist/Storable/Storable.xs | 118 +++++++++++++++++++++++++++++++++------------- dist/Storable/t/attach.t | 42 +++++++++++++++++ 4 files changed, 128 insertions(+), 35 deletions(-) create mode 100644 dist/Storable/t/attach.t diff --git a/MANIFEST b/MANIFEST index 4b68b19..a128a43 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3328,6 +3328,7 @@ dist/Storable/Storable.pm Storable extension dist/Storable/Storable.xs Storable extension dist/Storable/t/attach_errors.t Trigger and test STORABLE_attach errors dist/Storable/t/attach_singleton.t Test STORABLE_attach for the Singleton pattern +dist/Storable/t/attach.t Check STORABLE_attach doesn't create objects unnecessarily dist/Storable/t/blessed.t See if Storable works dist/Storable/t/canonical.t See if Storable works dist/Storable/t/circular_hook.t Test thaw hook called depth-first for circular refs diff --git a/dist/Storable/Storable.pm b/dist/Storable/Storable.pm index 00cc2e7..f297150 100644 --- a/dist/Storable/Storable.pm +++ b/dist/Storable/Storable.pm @@ -22,7 +22,7 @@ package Storable; @ISA = qw(Exporter); use vars qw($canonical $forgive_me $VERSION); -$VERSION = '2.45'; +$VERSION = '2.46'; BEGIN { if (eval { local $SIG{__DIE__}; require Log::Agent; 1 }) { diff --git a/dist/Storable/Storable.xs b/dist/Storable/Storable.xs index f0cfcea..300ba66 100644 --- a/dist/Storable/Storable.xs +++ b/dist/Storable/Storable.xs @@ -1024,7 +1024,7 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; * * i should be true iff sv is immortal (ie PL_sv_yes, PL_sv_no or PL_sv_undef) */ -#define SEEN(y,c,i) \ +#define SEEN(y,stash,i) \ STMT_START { \ if (!y) \ return (SV *) 0; \ @@ -1032,8 +1032,8 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; return (SV *) 0; \ TRACEME(("aseen(#%d) = 0x%"UVxf" (refcnt=%d)", cxt->tagnum-1, \ PTR2UV(y), SvREFCNT(y)-1)); \ - if (c) \ - BLESS((SV *) (y), c); \ + if (stash) \ + BLESS((SV *) (y), (HV *)(stash)); \ } STMT_END /* @@ -1041,12 +1041,10 @@ static const char byteorderstr_56[] = {BYTEORDER_BYTES_56, 0}; * "A" magic is added before the sv_bless for overloaded classes, this avoids * an expensive call to S_reset_amagic in sv_bless. */ -#define BLESS(s,p) \ +#define BLESS(s,stash) \ STMT_START { \ SV *ref; \ - HV *stash; \ - TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (p))); \ - stash = gv_stashpv((p), GV_ADD); \ + TRACEME(("blessing 0x%"UVxf" in %s", PTR2UV(s), (HvNAME_get(p)))); \ ref = newRV_noinc(s); \ if (cxt->in_retrieve_overloaded && Gv_AMG(stash)) \ { \ @@ -4049,6 +4047,7 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) SV *sv; SV *rv; GV *attach; + HV *stash; int obj_type; int clone = cxt->optype & ST_CLONE; char mtype = '\0'; @@ -4271,14 +4270,13 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) } /* - * Bless the object and look up the STORABLE_thaw hook. + * Look up the STORABLE_attach hook */ - - BLESS(sv, classname); + stash = gv_stashpv(classname, GV_ADD); /* Handle attach case; again can't use pkg_can because it only * caches one method */ - attach = gv_fetchmethod_autoload(SvSTASH(sv), "STORABLE_attach", FALSE); + attach = gv_fetchmethod_autoload(stash, "STORABLE_attach", FALSE); if (attach && isGV(attach)) { SV* attached; SV* attach_hook = newRV((SV*) GvCV(attach)); @@ -4317,7 +4315,13 @@ static SV *retrieve_hook(pTHX_ stcxt_t *cxt, const char *cname) CROAK(("STORABLE_attach did not return a %s object", classname)); } - hook = pkg_can(aTHX_ cxt->hook, SvSTASH(sv), "STORABLE_thaw"); + /* + * Bless the object and look up the STORABLE_thaw hook. + */ + + BLESS(sv, stash); + + hook = pkg_can(aTHX_ cxt->hook, stash, "STORABLE_thaw"); if (!hook) { /* * Hook not found. Maybe they did not require the module where this @@ -4458,6 +4462,7 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname) { SV *rv; SV *sv; + HV *stash; TRACEME(("retrieve_ref (#%d)", cxt->tagnum)); @@ -4471,7 +4476,11 @@ static SV *retrieve_ref(pTHX_ stcxt_t *cxt, const char *cname) */ rv = NEWSV(10002, 0); - SEEN(rv, cname, 0); /* Will return if rv is null */ + if (cname) + stash = gv_stashpv(cname, GV_ADD); + else + stash = 0; + SEEN(rv, stash, 0); /* Will return if rv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) return (SV *) 0; /* Failed */ @@ -4550,7 +4559,8 @@ static SV *retrieve_overloaded(pTHX_ stcxt_t *cxt, const char *cname) */ rv = NEWSV(10002, 0); - SEEN(rv, cname, 0); /* Will return if rv is null */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(rv, stash, 0); /* Will return if rv is null */ cxt->in_retrieve_overloaded = 1; /* so sv_bless doesn't call S_reset_amagic */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ cxt->in_retrieve_overloaded = 0; @@ -4630,10 +4640,12 @@ static SV *retrieve_tied_array(pTHX_ stcxt_t *cxt, const char *cname) { SV *tv; SV *sv; + HV *stash; TRACEME(("retrieve_tied_array (#%d)", cxt->tagnum)); tv = NEWSV(10002, 0); + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; SEEN(tv, cname, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) @@ -4659,11 +4671,13 @@ static SV *retrieve_tied_hash(pTHX_ stcxt_t *cxt, const char *cname) { SV *tv; SV *sv; + HV *stash; TRACEME(("retrieve_tied_hash (#%d)", cxt->tagnum)); tv = NEWSV(10002, 0); - SEEN(tv, cname, 0); /* Will return if tv is null */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) return (SV *) 0; /* Failed */ @@ -4687,11 +4701,13 @@ static SV *retrieve_tied_scalar(pTHX_ stcxt_t *cxt, const char *cname) { SV *tv; SV *sv, *obj = NULL; + HV *stash; TRACEME(("retrieve_tied_scalar (#%d)", cxt->tagnum)); tv = NEWSV(10002, 0); - SEEN(tv, cname, 0); /* Will return if rv is null */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(tv, stash, 0); /* Will return if rv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) { return (SV *) 0; /* Failed */ @@ -4724,11 +4740,13 @@ static SV *retrieve_tied_key(pTHX_ stcxt_t *cxt, const char *cname) SV *tv; SV *sv; SV *key; + HV *stash; TRACEME(("retrieve_tied_key (#%d)", cxt->tagnum)); tv = NEWSV(10002, 0); - SEEN(tv, cname, 0); /* Will return if tv is null */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) return (SV *) 0; /* Failed */ @@ -4755,12 +4773,14 @@ static SV *retrieve_tied_idx(pTHX_ stcxt_t *cxt, const char *cname) { SV *tv; SV *sv; + HV *stash; I32 idx; TRACEME(("retrieve_tied_idx (#%d)", cxt->tagnum)); tv = NEWSV(10002, 0); - SEEN(tv, cname, 0); /* Will return if tv is null */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(tv, stash, 0); /* Will return if tv is null */ sv = retrieve(aTHX_ cxt, 0); /* Retrieve <object> */ if (!sv) return (SV *) 0; /* Failed */ @@ -4788,6 +4808,7 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname) { I32 len; SV *sv; + HV *stash; RLEN(len); TRACEME(("retrieve_lscalar (#%d), len = %"IVdf, cxt->tagnum, (IV) len)); @@ -4797,7 +4818,8 @@ static SV *retrieve_lscalar(pTHX_ stcxt_t *cxt, const char *cname) */ sv = NEWSV(10002, len); - SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ if (len == 0) { sv_setpvn(sv, "", 0); @@ -4839,6 +4861,7 @@ static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname) { int len; SV *sv; + HV *stash; GETMARK(len); TRACEME(("retrieve_scalar (#%d), len = %d", cxt->tagnum, len)); @@ -4848,7 +4871,8 @@ static SV *retrieve_scalar(pTHX_ stcxt_t *cxt, const char *cname) */ sv = NEWSV(10002, len); - SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ /* * WARNING: duplicates parts of sv_setpv and breaks SV data encapsulation. @@ -5027,13 +5051,15 @@ static SV *retrieve_lvstring(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv; + HV *stash; IV iv; TRACEME(("retrieve_integer (#%d)", cxt->tagnum)); READ(&iv, sizeof(iv)); sv = newSViv(iv); - SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ TRACEME(("integer %"IVdf, iv)); TRACEME(("ok (retrieve_integer at 0x%"UVxf")", PTR2UV(sv))); @@ -5050,6 +5076,7 @@ static SV *retrieve_integer(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv; + HV *stash; I32 iv; TRACEME(("retrieve_netint (#%d)", cxt->tagnum)); @@ -5062,7 +5089,8 @@ static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname) sv = newSViv(iv); TRACEME(("network integer (as-is) %d", iv)); #endif - SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ TRACEME(("ok (retrieve_netint at 0x%"UVxf")", PTR2UV(sv))); @@ -5078,13 +5106,15 @@ static SV *retrieve_netint(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv; + HV *stash; NV nv; TRACEME(("retrieve_double (#%d)", cxt->tagnum)); READ(&nv, sizeof(nv)); sv = newSVnv(nv); - SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ TRACEME(("double %"NVff, nv)); TRACEME(("ok (retrieve_double at 0x%"UVxf")", PTR2UV(sv))); @@ -5101,6 +5131,7 @@ static SV *retrieve_double(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv; + HV *stash; int siv; signed char tmp; /* Workaround for AIX cc bug --H.Merijn Brand */ @@ -5110,7 +5141,8 @@ static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname) TRACEME(("small integer read as %d", (unsigned char) siv)); tmp = (unsigned char) siv - 128; sv = newSViv(tmp); - SEEN(sv, cname, 0); /* Associate this new scalar with tag "tagnum" */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* Associate this new scalar with tag "tagnum" */ TRACEME(("byte %d", tmp)); TRACEME(("ok (retrieve_byte at 0x%"UVxf")", PTR2UV(sv))); @@ -5125,12 +5157,14 @@ static SV *retrieve_byte(pTHX_ stcxt_t *cxt, const char *cname) */ static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname) { - SV* sv; + SV *sv; + HV *stash; TRACEME(("retrieve_undef")); sv = newSV(0); - SEEN(sv, cname, 0); + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); return sv; } @@ -5143,6 +5177,7 @@ static SV *retrieve_undef(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv = &PL_sv_undef; + HV *stash; TRACEME(("retrieve_sv_undef")); @@ -5152,7 +5187,8 @@ static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname) if (cxt->where_is_undef == -1) { cxt->where_is_undef = cxt->tagnum; } - SEEN(sv, cname, 1); + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 1); return sv; } @@ -5164,10 +5200,12 @@ static SV *retrieve_sv_undef(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv = &PL_sv_yes; + HV *stash; TRACEME(("retrieve_sv_yes")); - SEEN(sv, cname, 1); + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 1); return sv; } @@ -5179,10 +5217,12 @@ static SV *retrieve_sv_yes(pTHX_ stcxt_t *cxt, const char *cname) static SV *retrieve_sv_no(pTHX_ stcxt_t *cxt, const char *cname) { SV *sv = &PL_sv_no; + HV *stash; TRACEME(("retrieve_sv_no")); - SEEN(sv, cname, 1); + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 1); return sv; } @@ -5201,6 +5241,7 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) I32 i; AV *av; SV *sv; + HV *stash; TRACEME(("retrieve_array (#%d)", cxt->tagnum)); @@ -5211,7 +5252,8 @@ static SV *retrieve_array(pTHX_ stcxt_t *cxt, const char *cname) RLEN(len); TRACEME(("size = %d", len)); av = newAV(); - SEEN(av, cname, 0); /* Will return if array not allocated nicely */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(av, stash, 0); /* Will return if array not allocated nicely */ if (len) av_extend(av, len); else @@ -5253,6 +5295,7 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) I32 i; HV *hv; SV *sv; + HV *stash; TRACEME(("retrieve_hash (#%d)", cxt->tagnum)); @@ -5263,7 +5306,8 @@ static SV *retrieve_hash(pTHX_ stcxt_t *cxt, const char *cname) RLEN(len); TRACEME(("size = %d", len)); hv = newHV(); - SEEN(hv, cname, 0); /* Will return if table not allocated properly */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(hv, stash, 0); /* Will return if table not allocated properly */ if (len == 0) return (SV *) hv; /* No data follow if table empty */ hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */ @@ -5328,6 +5372,7 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname) I32 i; HV *hv; SV *sv; + HV *stash; int hash_flags; GETMARK(hash_flags); @@ -5350,7 +5395,8 @@ static SV *retrieve_flag_hash(pTHX_ stcxt_t *cxt, const char *cname) RLEN(len); TRACEME(("size = %d, flags = %d", len, hash_flags)); hv = newHV(); - SEEN(hv, cname, 0); /* Will return if table not allocated properly */ + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(hv, stash, 0); /* Will return if table not allocated properly */ if (len == 0) return (SV *) hv; /* No data follow if table empty */ hv_ksplit(hv, len + 1); /* pre-extend hash to save multiple splits */ @@ -5466,6 +5512,7 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) int type, count, tagnum; SV *cv; SV *sv, *text, *sub, *errsv; + HV *stash; TRACEME(("retrieve_code (#%d)", cxt->tagnum)); @@ -5478,7 +5525,8 @@ static SV *retrieve_code(pTHX_ stcxt_t *cxt, const char *cname) */ tagnum = cxt->tagnum; sv = newSViv(0); - SEEN(sv, cname, 0); + stash = cname ? gv_stashpv(cname, GV_ADD) : 0; + SEEN(sv, stash, 0); /* * Retrieve the source of the code reference @@ -6062,6 +6110,7 @@ first_time: /* Will disappear when support for old format is dropped */ if (cxt->ver_major < 2) { while ((type = GETCHAR()) != SX_STORED) { I32 len; + HV* stash; switch (type) { case SX_CLASS: GETMARK(len); /* Length coded on a single char */ @@ -6077,7 +6126,8 @@ first_time: /* Will disappear when support for old format is dropped */ if (len) READ(kbuf, len); kbuf[len] = '\0'; /* Mark string end */ - BLESS(sv, kbuf); + stash = gv_stashpvn(kbuf, len, GV_ADD); + BLESS(sv, stash); } } diff --git a/dist/Storable/t/attach.t b/dist/Storable/t/attach.t new file mode 100644 index 0000000..5ffdae5 --- /dev/null +++ b/dist/Storable/t/attach.t @@ -0,0 +1,42 @@ +#!./perl -w +# +# This file tests that Storable correctly uses STORABLE_attach hooks + +sub BEGIN { + unshift @INC, 't'; + unshift @INC, 't/compat' if $] < 5.006002; + require Config; import Config; + if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) { + print "1..0 # Skip: Storable was not built\n"; + exit 0; + } +} + +use Test::More tests => 3; +use Storable (); + +{ + my $destruct_cnt = 0; + my $obj = bless {data => 'ok'}, 'My::WithDestructor'; + my $target = Storable::thaw( Storable::freeze( $obj ) ); + is( $target->{data}, 'ok', 'We got correct object after freeze/thaw' ); + is( $destruct_cnt, 0, 'No tmp objects created by Storable' ); + undef $obj; + undef $target; + is( $destruct_cnt, 2, 'Only right objects destroyed at the end' ); + + package My::WithDestructor; + + sub STORABLE_freeze { + my ($self, $clone) = @_; + return $self->{data}; + } + + sub STORABLE_attach { + my ($class, $clone, $string) = @_; + return bless {data => $string}, 'My::WithDestructor'; + } + + sub DESTROY { $destruct_cnt++; } +} + -- Perl5 Master Repository
