[perl #92254, #92256] Fix SAVE_DEFSV to do refcounting

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.

4 files changed, 28 insertions, 8 deletions

diff --git a/perl.h b/perl.h
index 184d4b55b4..a373511909 100644
--- a/perl.h
+++ b/perl.h
@@ -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 */
 
diff --git a/pp_ctl.c b/pp_ctl.c
index 8ee4d793b0..ce349bd2fe 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -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) {
diff --git a/t/op/grep.t b/t/op/grep.t
index 0a1f8c9090..94fa43cf6c 100644
--- a/t/op/grep.t
+++ b/t/op/grep.t
@@ -10,7 +10,7 @@ BEGIN {
     require "test.pl";
 }
 
-plan( tests => 61 );
+plan( tests => 62 );
 
 {
     my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
@@ -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 *_ }';
diff --git a/t/re/reg_eval_scope.t b/t/re/reg_eval_scope.t
index a23321f2d2..00e7d99fec 100644
--- a/t/re/reg_eval_scope.t
+++ b/t/re/reg_eval_scope.t
@@ -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) 
@@ -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";