Skip to content

Commit

Permalink
In newXS, clear glob slot before lowering refcount.
Browse files Browse the repository at this point in the history
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)
  • Loading branch information
Father Chrysostomos committed Nov 12, 2013
1 parent 4571f4a commit 7004ee4
Show file tree
Hide file tree
Showing 2 changed files with 20 additions and 1 deletion.
1 change: 1 addition & 0 deletions op.c
Expand Up @@ -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;
}
Expand Down
20 changes: 19 additions & 1 deletion t/op/sub.t
Expand Up @@ -6,7 +6,7 @@ BEGIN {
require './test.pl';
}

plan( tests => 30 );
plan( tests => 32 );

sub empty_sub {}

Expand Down Expand Up @@ -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';
}

0 comments on commit 7004ee4

Please sign in to comment.