Skip to content

Commit

Permalink
[perl #92254, #92256] Fix SAVE_DEFSV to do refcounting
Browse files Browse the repository at this point in the history
The current definition of SAVE_DEFSV doesn’t take reference count-
ing into account.  Every instance of it in the perl core is buggy
as a result.

Most are also followed by DEFSV_set, which is likewise buggy.

This commit implements SAVE_DEFSV in terms of save_gp and
SAVEGENERICSV if PERL_CORE is defined.  save_gp and SAVEGENERICSV are
what local(*_) = \$foo uses.  Changing the definition for XS code is
probably too risky this close to 5.16.  It should probably be changed
later, though.

DEFSV_set is now changed to do reference counting too.
  • Loading branch information
Father Chrysostomos committed Jan 9, 2012
1 parent bbff98d commit 55b5114
Show file tree
Hide file tree
Showing 4 changed files with 28 additions and 8 deletions.
13 changes: 11 additions & 2 deletions perl.h
Expand Up @@ -1355,11 +1355,20 @@ EXTERN_C char *crypt(const char *, const char *);

#ifdef PERL_CORE
# define DEFSV (0 + GvSVn(PL_defgv))
# define DEFSV_set(sv) \
(SvREFCNT_dec(GvSV(PL_defgv)), GvSV(PL_defgv) = SvREFCNT_inc(sv))
# define SAVE_DEFSV \
( \
save_gp(PL_defgv, 0), \
GvINTRO_off(PL_defgv), \
SAVEGENERICSV(GvSV(PL_defgv)), \
GvSV(PL_defgv) = NULL \
)
#else
# define DEFSV GvSVn(PL_defgv)
# define DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
#endif
#define DEFSV_set(sv) (GvSV(PL_defgv) = (sv))
#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))

#define ERRHV GvHV(PL_errgv) /* XXX unused, here for compatibility */

Expand Down
5 changes: 1 addition & 4 deletions pp_ctl.c
Expand Up @@ -5477,14 +5477,11 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
int count;

ENTER_with_name("call_filter_sub");
save_gp(PL_defgv, 0);
GvINTRO_off(PL_defgv);
SAVEGENERICSV(GvSV(PL_defgv));
SAVE_DEFSV;
SAVETMPS;
EXTEND(SP, 2);

DEFSV_set(upstream);
SvREFCNT_inc_simple_void_NN(upstream);
PUSHMARK(SP);
mPUSHi(0);
if (filter_state) {
Expand Down
10 changes: 9 additions & 1 deletion t/op/grep.t
Expand Up @@ -10,7 +10,7 @@ BEGIN {
require "test.pl";
}

plan( tests => 61 );
plan( tests => 62 );

{
my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
Expand Down Expand Up @@ -214,3 +214,11 @@ plan( tests => 61 );
like($@, qr/Missing comma after first argument to grep function/,
"proper error on variable as block. [perl #37314]");
}

# [perl #92254] freeing $_ in gremap block
{
my $y;
grep { undef *_ } $y;
map { undef *_ } $y;
}
pass 'no double frees with grep/map { undef *_ }';
8 changes: 7 additions & 1 deletion t/re/reg_eval_scope.t
Expand Up @@ -9,7 +9,7 @@ BEGIN {
skip_all_if_miniperl("no dynamic loading on miniperl, no re");
}

plan 17;
plan 18;

# Functions for turning to-do-ness on and off (as there are so many
# to-do tests)
Expand Down Expand Up @@ -155,3 +155,9 @@ CODE
fresh_perl_is <<'CODE', '45', { stderr => 1 }, '(?{goto})';
my $a=4; my $b=5; "a" =~ /(?{goto _})a/; die; _: print $a,$b
CODE

off;

# [perl #92256]
{ my $y = "a"; $y =~ /a(?{ undef *_ })/ }
pass "undef *_ in a re-eval does not cause a double free";

0 comments on commit 55b5114

Please sign in to comment.