Undeffing a gv in DESTROY triggered by undeffing the same gv

$ ./perl -Ilib -e 'sub foo{} bless \&foo; DESTROY { undef *foo } undef *foo'
Attempt to free unreferenced glob pointers, Perl interpreter: 0x7fd6a3803200 at -e line 1.

Lowering the reference count on the glob pointer only after freeing
the contents fixes this.

diff --git a/gv.c b/gv.c
index 1c86029..d29b1ef 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -2351,9 +2351,10 @@ Perl_gp_free(pTHX_ GV *gv)
                         pTHX__FORMAT pTHX__VALUE);
         return;
     }
-    if (--gp->gp_refcnt > 0) {
+    if (gp->gp_refcnt > 1) {
        if (gp->gp_egv == gv)
            gp->gp_egv = 0;
+       gp->gp_refcnt--;
        GvGP_set(gv, NULL);
         return;
     }
@@ -2411,6 +2412,7 @@ Perl_gp_free(pTHX_ GV *gv)
       }
     }
 
+    gp->gp_refcnt--;
     Safefree(gp);
     GvGP_set(gv, NULL);
 }

diff --git a/t/op/gv.t b/t/op/gv.t
index 4910ee2..e1c9fad 100644 (file)
--- a/t/op/gv.t
+++ b/t/op/gv.t
@@ -12,7 +12,7 @@ BEGIN {
 
 use warnings;
 
-plan( tests => 258 );
+plan( tests => 259 );
 
 # type coercion on assignment
 $foo = 'foo';
@@ -947,6 +947,21 @@ ok eval {
   'no error when gp_free calls a destructor that assigns to the gv';
 }
 
+# This is a similar test, for destructors seeing a GV without a reference
+# count on its gp.
+sub undefine_me_if_you_dare {}
+bless \&undefine_me_if_you_dare, "Undefiner";
+sub Undefiner::DESTROY {
+    undef *undefine_me_if_you_dare;
+}
+{
+    my $w;
+    local $SIG{__WARN__} = sub { $w .= shift };
+    undef *undefine_me_if_you_dare;
+    is $w, undef,
+      'undeffing a gv in DESTROY triggered by undeffing the same gv'
+}
+
 # *{undef}
 eval { *{my $undef} = 3 };
 like $@, qr/^Can't use an undefined value as a symbol reference at /,