This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #118907] Do not call DESTROY on empty objects with STORABLE_attach
authorTony Cook <tony@develop-help.com>
Wed, 24 Jul 2013 06:00:45 +0000 (16:00 +1000)
committerTony Cook <tony@develop-help.com>
Wed, 24 Jul 2013 06:00:45 +0000 (16:00 +1000)
avoids creating temporary objects for STORABLE_attach when they aren't
needed.

MANIFEST
dist/Storable/Storable.pm
dist/Storable/Storable.xs
dist/Storable/t/attach.t [new file with mode: 0644]

index 4b68b19..a128a43 100644 (file)
--- 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
index 00cc2e7..f297150 100644 (file)
@@ -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 }) {
index f0cfcea..300ba66 100644 (file)
@@ -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 (file)
index 0000000..5ffdae5
--- /dev/null
@@ -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++; }
+}
+