In perl.git, the branch blead has been updated
<
http://perl5.git.perl.org/perl.git/commitdiff/2639089b2b71c9124405bd9634b99be22b265f09?hp=dbf7dff66e440223aca0cc87655e65e096264d59>
- Log -----------------------------------------------------------------
commit 2639089b2b71c9124405bd9634b99be22b265f09
Author: Daniel Dragan <
bul...@hotmail.com>
Date: Wed Nov 7 18:03:10 2012 -0500
refactor gv.c:Perl_newGP
This commit fixes a scenario was strlen("") was called unnecessarily.
Replaced with 0. Also various func calls were rearranged for more calls
to happen near the beginning to maximize use of volatile registers
towards the end for PERL_HASH. PERL_HASH was moved to be closer to the
first usage of var hash. Setting gp_line to 0 was removed since the block
was just calloced and is already 0. Filling of gp.gp_egv was moved early
so var gv on C stack might get reused by compiler optimizer to store
something else to decrease the stack frame size of Perl_newGP.
PERL_ARGS_ASSERT_NEWGP was moved to be outside of an ifdef.
Also see commits 128165928a7 , 19bad6733a8 , 1df5f7c1950 , f4890806d3 .
M gv.c
commit 9e942bf50af043414de49df7ae0d6fffc515426e
Author: Father Chrysostomos <
spr...@cpan.org>
Date: Thu Nov 8 18:14:06 2012 -0800
To-do test for eval "END OF TERMS" leaking
I found this memory leak by evaluating lines of the Copying file as
Perl code. :-)
The parser requires yylex to return exactly one token with each call.
Sometimes yylex needs to record a few tokens ahead of time, so its
puts them in its forced token stack. The next call to yylex then pops
the pending token off that stack.
Ops belong to their subroutines. If the subroutine is freed before
its root is attached, all the ops created when PL_compcv pointed
to that sub are freed as well. To avoid crashes, the ops on the
savestack and the forced token stack are specially marked so they are
not freed when the sub is freed.
When it comes to evaluating "END OF TERMS AND CONDITIONS", the END
token causes a subroutine to be created and placed in PL_compcv. The
OF token is treated by the lexer as a method call on the TERMS pack-
age. The TERMS token is placed in the forced token stack as an sv in
an op for a WORD token, and a METHOD token for OF is returned. As
soon as the parser sees the OF, it generates an error, which results
in LEAVE_SCOPE being called, which frees the subroutine for END while
TERMS is still on the forced token stack. So the subroutine’s op
cleanup skips that op. Then the parser calls back into the lexer,
which returns the TERMS token from the forced token stack. Since
there has been an error, the parser discards that token, so the op
is never freed. The forced token stack cleanup that happens in
parser_free does not catch this, as the token is no longer on
that stack.
I have not yet determined how to fix this problem.
M t/op/svleak.t
commit f248b511d4cec43cf11c513349ec774637fe412b
Author: Father Chrysostomos <
spr...@cpan.org>
Date: Tue Nov 6 23:59:51 2012 -0800
Another regexp charclass leak
Compiling a negated character class can cause internal temporary sca-
lars to leak, as of v5.17.1-252-gea364ff.
(I don’t understand how v5.17.1-252-gea364ff caused it, but bisect
points to it.)
M regcomp.c
M t/op/svleak.t
commit f59c2126a21d484c2fda0cce4954e191828a50e4
Author: Father Chrysostomos <
spr...@cpan.org>
Date: Tue Nov 6 23:56:56 2012 -0800
leakfinder.pl: Yet mair exceptions
M Porting/
leakfinder.pl
commit 6cc6220486894d96dd9ebc2105dd90fc49a3a596
Author: Father Chrysostomos <
spr...@cpan.org>
Date: Tue Nov 6 16:42:34 2012 -0800
regcomp.c: Typo
M regcomp.c
-----------------------------------------------------------------------
Summary of changes:
Porting/
leakfinder.pl | 5 +++--
gv.c | 43 ++++++++++++++++++++++++++-----------------
regcomp.c | 4 ++--
t/op/svleak.t | 8 +++++++-
4 files changed, 38 insertions(+), 22 deletions(-)
diff --git a/Porting/
leakfinder.pl b/Porting/
leakfinder.pl
index 91453bc..3c1c078 100644
--- a/Porting/
leakfinder.pl
+++ b/Porting/
leakfinder.pl
@@ -24,6 +24,7 @@ for(`find .`) {
next if /rm -rf/; # Could be an example from perlsec, e.g.
next if /END\s*\{/; # Creating an END block creates SVs, obviously
next if /^\s*(?:push|unshift)/;
+ next if /\bselect(?:\s*\()[^()]+,/; # 4-arg select hangs
my $q = s/[\\']/sprintf "\\%02x", ord $&/gore
=~ s/\0/'."\\0".'/grid;
$prog = <<end;
@@ -49,11 +50,11 @@ end
BEGIN {
@exceptions = split /^/, <<'end';
+$char++ while substr( $got, $char, 1 ) eq substr( $wanted, $char, 1 );
do {$x[$x] = $x;} while ($x++) < 10;
eval 'v23: $counter++; goto v23 unless $counter == 2';
eval 'v23 : $counter++; goto v23 unless $counter == 2';
-my $select_ret = select($rout = $rin, undef, undef, $timeout);
-select(undef,undef,undef,$delay);
+sleep;
end
@exceptions{@exceptions} = ();
}
diff --git a/gv.c b/gv.c
index 40f7c23..9de8886 100644
--- a/gv.c
+++ b/gv.c
@@ -162,17 +162,37 @@ Perl_newGP(pTHX_ GV *const gv)
{
GP *gp;
U32 hash;
-#ifdef USE_ITHREADS
- const char *const file
- = (PL_curcop && CopFILE(PL_curcop)) ? CopFILE(PL_curcop) : "";
- const STRLEN len = strlen(file);
-#else
- SV *const temp_sv = CopFILESV(PL_curcop);
const char *file;
STRLEN len;
+#ifndef USE_ITHREADS
+ SV * temp_sv;
+#endif
PERL_ARGS_ASSERT_NEWGP;
+ Newxz(gp, 1, GP);
+ gp->gp_egv = gv; /* allow compiler to reuse gv after this */
+#ifndef PERL_DONT_CREATE_GVSV
+ gp->gp_sv = newSV(0);
+#endif
+#ifdef USE_ITHREADS
+ if (PL_curcop) {
+ gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+ if (CopFILE(PL_curcop)) {
+ file = CopFILE(PL_curcop);
+ len = strlen(file);
+ }
+ else goto no_file;
+ }
+ else {
+ no_file:
+ file = "";
+ len = 0;
+ }
+#else
+ if(PL_curcop)
+ gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */
+ temp_sv = CopFILESV(PL_curcop);
if (temp_sv) {
file = SvPVX(temp_sv);
len = SvCUR(temp_sv);
@@ -183,18 +203,7 @@ Perl_newGP(pTHX_ GV *const gv)
#endif
PERL_HASH(hash, file, len);
-
- Newxz(gp, 1, GP);
-
-#ifndef PERL_DONT_CREATE_GVSV
- gp->gp_sv = newSV(0);
-#endif
-
- gp->gp_line = PL_curcop ? CopLINE(PL_curcop) : 0;
- /* XXX Ideally this cast would be replaced with a change to const char*
- in the struct. */
gp->gp_file_hek = share_hek(file, len, hash);
- gp->gp_egv = gv;
gp->gp_refcnt = 1;
return gp;
diff --git a/regcomp.c b/regcomp.c
index dbb8306..740bc94 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -11460,7 +11460,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth)
* reg() gets called (recursively) on the rewritten version, and this
* function will return what it constructs. (Actually the <multi-fold>s
* aren't physically removed from the [abcdefghi], it's just that they are
- * ignored in the recursion by means of a a flag:
+ * ignored in the recursion by means of a flag:
* <RExC_in_multi_char_class>.)
*
* ANYOF nodes contain a bit map for the first 256 characters, with the
@@ -13178,7 +13178,7 @@ parseit:
av_store(av, 0, (HAS_NONLOCALE_RUNTIME_PROPERTY_DEFINITION)
? listsv
- : &PL_sv_undef);
+ : (SvREFCNT_dec(listsv), &PL_sv_undef));
if (swash) {
av_store(av, 1, swash);
SvREFCNT_dec(cp_list);
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 129bd0a..964bcbb 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 56;
+plan tests => 58;
# 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
@@ -175,6 +175,7 @@ leak(2, 0,
eleak(2,0,'/[:]/');
eleak(2,0,'/[\xdf]/i');
+eleak(2,0,'s![^/]!!');
leak(2,0,sub { !$^V }, '[perl #109762] version object in boolean context');
@@ -208,6 +209,11 @@ eleak(2, !!$Config{mad}, 'no warnings; 2 2;BEGIN{}',
'implicit "use Errno" after syntax error');
}
eleak(2, 0, "\"\$\0\356\"", 'qq containing $ <null> something');
+{
+ local $::TODO = 'eval "END blah blah" still leaks';
+ eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words');
+}
+
# [perl #114764] Attributes leak scalars
leak(2, 0, sub { eval 'my $x : shared' }, 'my $x :shared used to leak');
--
Perl5 Master Repository