develooper Front page | perl.perl5.changes | Postings from November 2010

[perl.git] branch blead, updated. v5.13.7-108-g78da762

From:
Father Chrysostomos
Date:
November 26, 2010 06:27
Subject:
[perl.git] branch blead, updated. v5.13.7-108-g78da762
Message ID:
E1PLzGk-0004BL-R5@camel.ams6.corp.booking.com
In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/78da7625590089213831ed5137e24598b0cd3cea?hp=fd8c3383aea40326a20c5e582ecf50ee7d7bfcb9>

- Log -----------------------------------------------------------------
commit 78da7625590089213831ed5137e24598b0cd3cea
Author: Father Chrysostomos <sprout@cpan.org>
Date:   Fri Nov 26 06:25:36 2010 -0800

    Stop eval "BEGIN{die}" from leaking
    
    This fixes the rest of [perl #78438].
    
    eval "BEGIN{die}" creates a *{"_<(eval 1)"} glob regardless of $^P’s
    setting in non-threaded builds as of change f9bddea (5.12.0).
    
    Here are the results with various configurations:
    
    version  threaded  eval text  $^P  Is *{"_<(eval 1)"} set?
    -------  --------  ---------  ---  -----------------------
    5.10.1   yes       BEGIN{}      0  no
    5.10.1   yes       BEGIN{die}   0  no
    5.10.1   yes       BEGIN{}    0xA  yes
    5.10.1   yes       BEGIN{die} 0xA  no
    
    5.10.1   no        BEGIN{}      0  no
    5.10.1   no        BEGIN{die}   0  no
    5.10.1   no        BEGIN{}    0xA  yes
    5.10.1   no        BEGIN{die} 0xA  no
    
    5.13.7   yes       BEGIN{}      0  no
    5.13.7   yes       BEGIN{die}   0  no
    5.13.7   yes       BEGIN{}    0xA  yes
    5.13.7   yes       BEGIN{die} 0xA  yes
    
    5.13.7   no        BEGIN{}      0  no
    5.13.7   no        BEGIN{die}   0  yes
    5.13.7   no        BEGIN{}    0xA  yes
    5.13.7   no        BEGIN{die} 0xA  yes
    
    Notice that, for non-threaded builds, BEGIN{die} goes from never sav-
    ing the text to always saving it.
    
    The commit in question is:
    
    commit f9bddea7d2a0d824366014c8ee6ba57e7dedd8c3
    Author: Nicholas Clark <nick@ccl4.org>
    Date:   Tue Dec 2 20:43:58 2008 +0000
    
        Implement PERLDBf_SAVESRC_INVALID, which saves source lines for string
        evals that fail to compile.
    
        p4raw-id: //depot/perl@34985
    
    It stops unconditionally using the scoping mechanism to delete
    $::{"_<(eval $num)"} on compilation failure:
    
    -    safestr = savepvn(tmpbuf, len);
    -    SAVEDELETE(PL_defstash, safestr, len);
    
    but instead does it explicitly in this block:
    
    +    if (doeval(gimme, NULL, runcv, seq)) {
    +	if (was != PL_breakable_sub_gen /* Some subs defined here. */
    +	    ? (PERLDB_LINE || PERLDB_SAVESRC)
    +	    :  PERLDB_SAVESRC_NOSUBS) {
    +	    /* Retain the filegv we created.  */
    +	} else {
    +	    char *const safestr = savepvn(tmpbuf, len);
    +	    SAVEDELETE(PL_defstash, safestr, len);
    +	}
    +	return DOCATCH(PL_eval_start);
    +    } else {
    +	/* We have already left the scope set up earler thanks to the LEAVE
    +	   in doeval().  */
    +	if (PERLDB_SAVESRC_INVALID) {
    +	    /* Retain the filegv we created.  */
    +	} else {
    +	    (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD);
    +	}
    +	return PL_op->op_next;
    +    }
    
    In the case of BEGIN{die}, that doeval() never returns, so the
    clean-up code is not reached.
    
    S_doeval never returns because call_list calls Perl_croak if it
    catches a BEGIN error (appending the extra ‘BEGIN failed--compilation
    aborted’, etc.). That takes execution all the way back to perl_run, so
    it bypasses the clean-up code in pp_entereval.
    
    What’s leaking is the GV created earlier in pp_entereval by this line:
    
        CopFILE_set(&PL_compiling, tmpbuf+2);
    
    CopFILE_set simply stores a string under threads, but creates a GV
    under non-threaded builds.
    
    This commit solves the problem by scheduling a deletion *before* call-
    ing doeval, if the source lines have not been saved.
    
    This works because the usual code to handle it is only bypassed when
    there is a BEGIN block (a subroutine), so PL_breakable_sub_gen will
    have gone up. So we never need to delete the saved lines when that
    code is bypassed.
-----------------------------------------------------------------------

Summary of changes:
 pp_ctl.c               |    9 ++++++++-
 t/comp/retainedlines.t |   19 ++++++++++++++++++-
 2 files changed, 26 insertions(+), 2 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index a2c3b7e..13a4f22 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3843,6 +3843,7 @@ PP(pp_entereval)
     const I32 gimme = GIMME_V;
     const U32 was = PL_breakable_sub_gen;
     char tbuf[TYPE_DIGITS(long) + 12];
+    bool saved_delete = FALSE;
     char *tmpbuf = tbuf;
     STRLEN len;
     CV* runcv;
@@ -3927,6 +3928,12 @@ PP(pp_entereval)
 
     if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 	save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
+    else {
+	char *const safestr = savepvn(tmpbuf, len);
+	SAVEDELETE(PL_defstash, safestr, len);
+	saved_delete = TRUE;
+    }
+    
     PUTBACK;
 
     if (doeval(gimme, NULL, runcv, seq)) {
@@ -3934,7 +3941,7 @@ PP(pp_entereval)
 	    ? (PERLDB_LINE || PERLDB_SAVESRC)
 	    :  PERLDB_SAVESRC_NOSUBS) {
 	    /* Retain the filegv we created.  */
-	} else {
+	} else if (!saved_delete) {
 	    char *const safestr = savepvn(tmpbuf, len);
 	    SAVEDELETE(PL_defstash, safestr, len);
 	}
diff --git a/t/comp/retainedlines.t b/t/comp/retainedlines.t
index 8de8237..9a2a192 100644
--- a/t/comp/retainedlines.t
+++ b/t/comp/retainedlines.t
@@ -6,7 +6,7 @@
 # we've not yet verified that use works.
 # use strict;
 
-print "1..65\n";
+print "1..72\n";
 my $test = 0;
 
 sub failed {
@@ -131,3 +131,20 @@ foreach my $flags (0x0, 0x800, 0x1000, 0x1800) {
 	    "evals that fail are correctly cleaned up");
     }
 }
+
+# BEGIN blocks that die
+for (0xA, 0) {
+  local $^P = $_;
+
+  eval (my $prog = "BEGIN{die}\n");
+
+  if ($_) {
+    check_retained_lines($prog, 'eval that defines BEGIN that dies');
+  }
+  else {
+    my @after = grep { /eval/ } keys %::;
+
+    is (scalar @after, 0 + keys %seen,
+       "evals with BEGIN{die} are correctly cleaned up");
+  }
+}

--
Perl5 Master Repository



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About