replace leave_common() with leave_adjust_stacks()

Make the remaining callers of S_leave_common() use leave_adjust_stacks()
instead, then delete this static function.

This brings the benefits of freeing TEMPS on all scope exists that
has already been introduced on sub exits; uses the optimised code for
creating mortal copies; and finally unifies all the different 'process
return args on scope exit' implementations into single function.

embed.fnc

@@ -2073,8 +2073,6 @@ sR	|PerlIO *|check_type_and_open|NN SV *name
 #ifndef PERL_DISABLE_PMC
 sR	|PerlIO *|doopen_pm	|NN SV *name
 #endif
-s	|void	|leave_common	|NN SV **newsp|NN SV **mark|I32 gimme \
-				      |U32 flags|bool lvalue
 iRn	|bool	|path_is_searchable|NN const char *name
 sR	|I32	|run_user_filter|int idx|NN SV *buf_sv|int maxlen
 sR	|PMOP*	|make_matcher	|NN REGEXP* re

embed.h

@@ -1631,7 +1631,6 @@
 #define dopoptoloop(a)		S_dopoptoloop(aTHX_ a)
 #define dopoptosub_at(a,b)	S_dopoptosub_at(aTHX_ a,b)
 #define dopoptowhen(a)		S_dopoptowhen(aTHX_ a)
-#define leave_common(a,b,c,d,e)	S_leave_common(aTHX_ a,b,c,d,e)
 #define make_matcher(a)		S_make_matcher(aTHX_ a)
 #define matcher_matches_sv(a,b)	S_matcher_matches_sv(aTHX_ a,b)
 #define num_overflow		S_num_overflow

pp_ctl.c

@@ -2024,65 +2024,6 @@ PP(pp_dbstate)
 	return NORMAL;
 }
 
-/* S_leave_common: Common code that many functions in this file use on
-		   scope exit.
-
-   Process the return args on the stack in the range (mark+1..PL_stack_sp)
-   based on context, with any final args starting at newsp+1.
-   Args are mortal copied (or mortalied if lvalue) unless its safe to use
-   as-is, based on whether it has the specified flags. Note that most
-   callers specify flags as (SVs_PADTMP|SVs_TEMP), while leaveeval skips
-   SVs_PADTMP since its optree gets immediately freed, freeing its padtmps
-   at the same time.
-
-   Also, taintedness is cleared.
-*/
-
-STATIC void
-S_leave_common(pTHX_ SV **newsp, SV **mark, I32 gimme,
-			      U32 flags, bool lvalue)
-{
-    dSP;
-    PERL_ARGS_ASSERT_LEAVE_COMMON;
-
-    TAINT_NOT;
-    if (gimme == G_SCALAR) {
-	if (MARK < SP) {
-            SV *sv = *SP;
-
-	    *++newsp = ((SvFLAGS(sv) & flags) && SvREFCNT(sv) == 1
-                         && !SvMAGICAL(sv))
-			    ? sv 
-			    : lvalue
-				? sv_2mortal(SvREFCNT_inc_simple_NN(sv))
-				: sv_mortalcopy(sv);
-        }
-	else {
-	    EXTEND(newsp, 1);
-	    *++newsp = &PL_sv_undef;
-	}
-    }
-    else if (gimme == G_ARRAY) {
-	/* in case LEAVE wipes old return values */
-	while (++MARK <= SP) {
-            SV *sv = *MARK;
-	    if ((SvFLAGS(sv) & flags) && SvREFCNT(sv) == 1
-                         && !SvMAGICAL(sv))
-		*++newsp = sv;
-	    else {
-		*++newsp = lvalue
-			    ? sv_2mortal(SvREFCNT_inc_simple_NN(sv))
-			    : sv_mortalcopy(sv);
-		TAINT_NOT;	/* Each item is independent */
-	    }
-	}
-	/* When this function was called with MARK == newsp, we reach this
-	 * point with SP == newsp. */
-    }
-
-    PL_stack_sp = newsp;
-}
-
 
 PP(pp_enter)
 {
@@ -2114,8 +2055,8 @@ PP(pp_leave)
     if (gimme == G_VOID)
         PL_stack_sp = newsp;
     else
-        leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP,
-                               PL_op->op_private & OPpLVALUE);
+        leave_adjust_stacks(newsp, newsp, gimme,
+                                PL_op->op_private & OPpLVALUE ? 3 : 1);
 
     CX_LEAVE_SCOPE(cx);
     POPBASICBLK(cx);
@@ -2286,8 +2227,8 @@ PP(pp_leaveloop)
     if (gimme == G_VOID)
         PL_stack_sp = newsp;
     else
-        leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP,
-			       PL_op->op_private & OPpLVALUE);
+        leave_adjust_stacks(MARK, newsp, gimme,
+                                PL_op->op_private & OPpLVALUE ? 3 : 1);
 
     CX_LEAVE_SCOPE(cx);
     POPLOOP(cx);	/* Stack values are safe: release loop vars ... */
@@ -4279,7 +4220,7 @@ PP(pp_leaveeval)
     if (gimme == G_VOID)
         PL_stack_sp = newsp;
     else
-        leave_common(newsp, newsp, gimme, SVs_TEMP, FALSE);
+        leave_adjust_stacks(newsp, newsp, gimme, 0);
 
     /* the POPEVAL does a leavescope, which frees the optree associated
      * with eval, which if it frees the nextstate associated with
@@ -4374,7 +4315,7 @@ PP(pp_leavetry)
     if (gimme == G_VOID)
         PL_stack_sp = newsp;
     else
-        leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+        leave_adjust_stacks(newsp, newsp, gimme, 1);
     CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
     POPBLOCK(cx);
@@ -4417,7 +4358,7 @@ PP(pp_leavegiven)
     if (gimme == G_VOID)
         PL_stack_sp = newsp;
     else
-        leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+        leave_adjust_stacks(newsp, newsp, gimme, 1);
 
     CX_LEAVE_SCOPE(cx);
     POPGIVEN(cx);
@@ -5003,7 +4944,8 @@ PP(pp_leavewhen)
     if (gimme == G_VOID)
         PL_stack_sp = newsp;
     else
-        leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+        leave_adjust_stacks(newsp, newsp, gimme, 1);
+
     /* pop the WHEN, BLOCK and anything else before the GIVEN/FOR */
     assert(cxix < cxstack_ix);
     dounwind(cxix);

pp_hot.c

@@ -3463,9 +3463,10 @@ Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, I32 gimme, int pass)
                     else
                         SvTEMP_off(sv);
                 }
-                else {
+                else if (!SvPADTMP(sv)) {
                     /* mortalise arg to avoid it being freed during save
-                     * stack unwinding */
+                     * stack unwinding. Pad tmps don't need mortalising as
+                     * they're never freed */
                     SvREFCNT_inc_simple_void_NN(sv);
                     /* equivalent of sv_2mortal(), except that:
                      *  * it assumes that the temps stack has already been

proto.h

@@ -4507,9 +4507,6 @@ STATIC I32	S_dopoptosub_at(pTHX_ const PERL_CONTEXT* cxstk, I32 startingblock)
 STATIC I32	S_dopoptowhen(pTHX_ I32 startingblock)
 			__attribute__warn_unused_result__;
 
-STATIC void	S_leave_common(pTHX_ SV **newsp, SV **mark, I32 gimme, U32 flags, bool lvalue);
-#define PERL_ARGS_ASSERT_LEAVE_COMMON	\
-	assert(newsp); assert(mark)
 STATIC PMOP*	S_make_matcher(pTHX_ REGEXP* re)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_MAKE_MATCHER	\

t/op/do.t

@@ -293,4 +293,16 @@ SKIP: {
     }->(do { 1; delete $foo{bar} });
 }
 
+# A do block should FREETMPS on exit
+# RT #124248
+
+{
+    package p124248;
+    my $d = 0;
+    sub DESTROY { $d++ }
+    sub f { ::is($d, 1, "RT 124248"); }
+    f(do { 1; !!(my $x = bless []); });
+}
+
+
 done_testing();

t/op/grep.t

@@ -10,7 +10,7 @@ BEGIN {
     require "./test.pl";
 }
 
-plan( tests => 66 );
+plan( tests => 67 );
 
 {
     my @lol = ([qw(a b c)], [], [qw(1 2 3)]);
@@ -228,3 +228,13 @@ map is(\$_, \$_, '[perl #78194] \$_ == \$_ inside map ..., "$x"'),
     map { undef *_ } $y;
 }
 pass 'no double frees with grep/map { undef *_ }';
+
+# Don't mortalise PADTMPs.
+# This failed while I was messing with leave stuff (but not in a simple
+# test, so add one). The '1;' ensures the block is wrapped in ENTER/LEAVE;
+# the stringify returns a PADTMP. DAPM.
+
+{
+    my @a = map { 1; "$_" } 1,2;
+    is("@a", "1 2", "PADTMP");
+}