In newXS, clear glob slot before lowering refcount.

Otherwise, when newXS redefines a sub, the previous sub’s DESTROY can
see the same sub still in the typeglob, but without a reference count,
so *typeglob = sub {} frees the sub currently in $_[0].

$ perl5.18.1 -le '
    sub re::regmust{}
    bless \&re::regmust;
    DESTROY {
        print "before: $_[0]"; *re::regmust=sub{}; print "after: $_[0]"
    }
    require re;
'
before: main=CODE(0x7ff7eb02d6d8)
before: main=CODE(0x7ff7eb02d6d8)
after: main=CODE(0x7ff7eb02d6d8)
after: UNKNOWN(0x7ff7eb02d6d8)

diff --git a/op.c b/op.c
index bf7d4eb..6eee9e0 100644 (file)
--- a/op.c
+++ b/op.c
@@ -8140,6 +8140,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                                         ),
                                         cv, const_svp);
                 }
+                GvCV_set(gv,NULL);
                 SvREFCNT_dec_NN(cv);
                 cv = NULL;
             }

diff --git a/t/op/sub.t b/t/op/sub.t
index 2088662..ec8e211 100644 (file)
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan( tests => 30 );
+plan( tests => 32 );
 
 sub empty_sub {}
 
@@ -182,3 +182,21 @@ eval { &utf8::encode };
 # The main thing we are testing is that it did not crash.  But make sure 
 # *_{ARRAY} was untouched, too.
 is *_{ARRAY}, undef, 'goto &xsub when @_ does not exist';
+
+# We do not want re.pm loaded at this point.  Move this test up or find
+# another XSUB if this fails.
+ok !exists $INC{"re.pm"}, 're.pm not loaded yet';
+{
+    local $^W; # Suppress redef warnings
+    sub re::regmust{}
+    bless \&re::regmust;
+    DESTROY {
+        my $str1 = "$_[0]";
+        *re::regmust = sub{}; # GvSV had no refcount, so this freed it
+        my $str2 = "$_[0]";   # used to be UNKNOWN(0x7fdda29310e0)
+        @str = ($str1, $str2);
+    }
+    require re;
+    is $str[1], $str[0],
+      'XSUB clobbering sub whose DESTROY assigns to the glob';
+}