From 75bc488d4e88019e591cb7483510cbd02ac47320 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 17 Dec 2015 12:13:09 +0000 Subject: [PATCH] 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 | 2 -- embed.h | 1 - pp_ctl.c | 76 ++++++++----------------------------------------------------- pp_hot.c | 5 ++-- proto.h | 3 --- t/op/do.t | 12 ++++++++++ t/op/grep.t | 12 +++++++++- 7 files changed, 35 insertions(+), 76 deletions(-) diff --git a/embed.fnc b/embed.fnc index ddc2f32..f83432d 100644 --- a/embed.fnc +++ b/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 diff --git a/embed.h b/embed.h index f69c975..5bd0489 100644 --- a/embed.h +++ b/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 diff --git a/pp_ctl.c b/pp_ctl.c index 69b2446..f5d786e 100644 --- a/pp_ctl.c +++ b/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); diff --git a/pp_hot.c b/pp_hot.c index 1da07a3..9d0b1e2 100644 --- a/pp_hot.c +++ b/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 diff --git a/proto.h b/proto.h index faa0335..20fd667 100644 --- a/proto.h +++ b/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 \ diff --git a/t/op/do.t b/t/op/do.t index 3cc4eae..0bbab5e 100644 --- a/t/op/do.t +++ b/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(); diff --git a/t/op/grep.t b/t/op/grep.t index ea434a5..83ee4b6 100644 --- a/t/op/grep.t +++ b/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"); +} -- 1.8.3.1