leakfinder.pl: More exceptions
authorFather Chrysostomos <sprout@cpan.org>
Tue, 13 Nov 2012 22:53:33 +0000 (14:53 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 13 Nov 2012 22:54:22 +0000 (14:54 -0800)
Porting/leakfinder.pl
op.c
regexec.c
t/op/svleak.t

index a69a4b8..d276563 100644 (file)
@@ -84,6 +84,7 @@ $n = push @a, "rec0", "rec1", "rec2";
 $n = push @a, "rec3", "rec4$:";
 $n = unshift @a, "rec0", "rec1", "rec2";
 $n = unshift @a, "rec3", "rec4$:";
+@$obj = ($meth, (bless [@$obj]), 1); # Avoid circular reference
 @old = splice(@h, 1, 2, qw(bananas just before));
 package XS::APItest; require XSLoader; XSLoader::load()
 $pa = { -exitval => $pa };
@@ -94,6 +95,7 @@ prog => 'use Config; CHECK { $Config{awk} }',
 $p->{share_dir} = { dist => [ $p->{share_dir} ] };
 $p->{share_dir} = { dist => $p->{share_dir} };
 { push (@Bad, $key) }
+( push @hard, $file ), next
 { push @keep, $_ }
 { push (@values, $value) }
 $resp = [$resp]
@@ -102,6 +104,7 @@ $share_dir->{dist} = [ $share_dir->{dist} ];
 sleep;
 sleep(300);
 sleep($waitfor - 2);    # Workaround for perlbug #49073
+s![^/+]*$!man!&&-d&&!$s{$_}++&&push@m,#_;END{print"@m"}'
 $spec = [$spec, $_[0]];
 $stack[$i++] &= ~1;
 $step = [$step];
diff --git a/op.c b/op.c
index b2801c7..d7bf037 100644 (file)
--- a/op.c
+++ b/op.c
@@ -4650,7 +4650,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 
                /* attach the anon CV to the pad so that
                 * pad_fixup_inner_anons() can find it */
-               if (cv) (void)pad_add_anon(cv, o->op_type);
+               (void)pad_add_anon(cv, o->op_type);
                SvREFCNT_inc_simple_void(cv);
            }
            else {
@@ -7370,7 +7370,8 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 
     if (ec) {
        op_free(block);
-       SvREFCNT_dec(PL_compcv);
+       if (name) SvREFCNT_dec(PL_compcv);
+       else cv = PL_compcv;
        PL_compcv = 0;
        if (name && block) {
            const char *s = strrchr(name, ':');
@@ -8175,9 +8176,6 @@ Perl_ck_anoncode(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_ANONCODE;
 
-    /* After errors, we won’t have any sub. */
-    if (!cSVOPo->op_sv) return o;
-
     cSVOPo->op_targ = pad_add_anon((CV*)cSVOPo->op_sv, o->op_type);
     if (!PL_madskills)
        cSVOPo->op_sv = NULL;
index ecf8f87..72e2d7b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -4732,7 +4732,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                /* execute the code in the {...} */
 
                dSP;
-               SV ** before;
+               PADOFFSET before;
                OP * const oop = PL_op;
                COP * const ocurcop = PL_curcop;
                OP *nop;
@@ -4851,11 +4851,11 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                /* we don't use MULTICALL here as we want to call the
                 * first op of the block of interest, rather than the
                 * first op of the sub */
-               before = SP;
+               before = SP-PL_stack_base;
                PL_op = nop;
                CALLRUNOPS(aTHX);                       /* Scalar context. */
                SPAGAIN;
-               if (SP == before)
+               if (SP-PL_stack_base == before)
                    ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
                else {
                    ret = POPs;
@@ -4962,6 +4962,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                         * compiled */
                        S_regcp_restore(aTHX_ rex, runops_cp);
                    }
+                   SAVEFREESV(re_sv);
                    re = ReANY(re_sv);
                }
                 RXp_MATCH_COPIED_off(re);
index 8416656..95e1a3a 100644 (file)
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 65;
+plan tests => 67;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -182,6 +182,7 @@ eleak(2,0,'/[\xdf]/i');
 eleak(2,0,'s![^/]!!');
 eleak(2,0,'/[pp]/');
 eleak(2,0,'/[[:ascii:]]/');
+leak(2,0,sub { /(??{})/ }, '/(??{})/');
 
 leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
 
@@ -196,6 +197,7 @@ SKIP: {
 
 eleak(2, 0, '+sub:a{}', 'anon subs with invalid attributes');
 eleak(2, 0, 'no warnings; sub a{1 1}', 'sub with syntax error');
+eleak(2, 0, 'no warnings; sub {1 1}', 'anon sub with syntax error');
 
 # Syntax errors
 eleak(2, 0, '"${<<END}"