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)
),
cv, const_svp);
}
+ GvCV_set(gv,NULL);
SvREFCNT_dec_NN(cv);
cv = NULL;
}
require './test.pl';
}
-plan( tests => 30 );
+plan( tests => 32 );
sub empty_sub {}
# 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';
+}