This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #127494] don't cache AUTOLOAD as DESTROY
authorTony Cook <tony@develop-help.com>
Wed, 10 Feb 2016 03:30:08 +0000 (14:30 +1100)
committerTony Cook <tony@develop-help.com>
Wed, 10 Feb 2016 03:30:44 +0000 (14:30 +1100)
Otherwise S_curse() would need to do all the work gv_autoload_pvn()
already does to set up to call AUTOLOAD() (setting $AUTOLOAD etc.)

Instead, by not caching it, we ensure gv_autoload_pvn() is called
each time to perform the required setup.

This has a performance cost over adding that code to S_curse(), but the
cost of actually running the AUTOLOAD sub is likely to drown that out,
and is easily avoided by adding "sub DESTROY {}" to the module.

sv.c
t/op/method.t

diff --git a/sv.c b/sv.c
index 1650ed5..2b17a86 100644 (file)
--- a/sv.c
+++ b/sv.c
 #   define ASSERT_UTF8_CACHE(cache) NOOP
 #endif
 
+static const char S_destroy[] = "DESTROY";
+#define S_destroy_len (sizeof(S_destroy)-1)
+
 /* ============================================================================
 
 =head1 Allocation and deallocation of SVs.
@@ -6791,13 +6794,33 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
                              (void *)destructor, HvNAME(stash)) );
             }
             else {
-               GV * const gv =
-                   gv_fetchmethod_pvn_flags(stash, "DESTROY", 7, GV_AUTOLOAD);
-               if (gv) destructor = GvCV(gv);
-                meta->destroy_gen = PL_sub_generation;
-                meta->destroy = destructor;
-                DEBUG_o( Perl_deb(aTHX_ "Set cached DESTROY method %p for %s\n",
-                             (void *)destructor, HvNAME(stash)) );
+                bool autoload = FALSE;
+               GV *gv =
+                    gv_fetchmeth_pvn(stash, S_destroy, S_destroy_len, -1, 0);
+               if (gv)
+                    destructor = GvCV(gv);
+                if (!destructor) {
+                    gv = gv_autoload_pvn(stash, S_destroy, S_destroy_len,
+                                         GV_AUTOLOAD_ISMETHOD);
+                    if (gv)
+                        destructor = GvCV(gv);
+                    if (destructor)
+                        autoload = TRUE;
+                }
+                /* we don't cache AUTOLOAD for DESTROY, since this code
+                   would then need to set $__PACKAGE__::AUTOLOAD, or the
+                   equivalent for XS AUTOLOADs */
+                if (!autoload) {
+                    meta->destroy_gen = PL_sub_generation;
+                    meta->destroy = destructor;
+
+                    DEBUG_o( Perl_deb(aTHX_ "Set cached DESTROY method %p for %s\n",
+                                      (void *)destructor, HvNAME(stash)) );
+                }
+                else {
+                    DEBUG_o( Perl_deb(aTHX_ "Not caching AUTOLOAD for DESTROY method for %s\n",
+                                      HvNAME(stash)) );
+                }
            }
            assert(!destructor || SvTYPE(destructor) == SVt_PVCV);
            if (destructor
index 2a6b399..b915306 100644 (file)
@@ -471,7 +471,6 @@ is $kalled, 1, 'calling a class method via a magic variable';
     ok($autoloaded, "AUTOLOAD called for DESTROY");
 
     # 127494 - AUTOLOAD for DESTROY was called without setting $AUTOLOAD
-    local $::TODO = "caching of AUTOLOAD for DESTROY didn't set \$AUTOLOAD";
     my %methods;
     package AutoloadDestroy2;
     sub AUTOLOAD {