In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/dfba4714a9dc4c35123b4df0a5e1721ccb081d97?hp=8cc54175018f1cabb5c0354371c9e2ee24f8ee5a>
- Log -----------------------------------------------------------------
commit dfba4714a9dc4c35123b4df0a5e1721ccb081d97
Author: David Mitchell <da...@iabyn.com>
Date: Fri Apr 12 16:18:57 2019 +0100
warnings.t: skip some leaky tests
A couple of tests in 7fatal leak, and thus fail, when run under Address
Sanitizer. I have a proper fix for this, but it's too close to 5.30 code
freeze to justify merging it yet. So just skip the problematic tests for
now.
commit df10057779d7151c097d31e58b589c7b1e968d1f
Author: David Mitchell <da...@iabyn.com>
Date: Fri Apr 12 14:06:21 2019 +0100
fix leak in Perl_coresub_op()
This sub initially creates a new OP_COREARGS op to be made use of in the
various cases of a following switch statement. But in the specific case
of OP_SELECT, the op isn't actually used, and leaks. So don't allocate
it in this case.
The leak could be reproduced with the one-liner
defined &{"CORE::select"};
and was causing t/op/coresubs.t to fail under Address Sanitiser.
commit ad9115fb3ef3c0d588afd07c1b794e99cef3e1ed
Author: David Mitchell <da...@iabyn.com>
Date: Tue Apr 9 10:33:34 2019 +0100
Avoid leak/crash calling CORE::foo()
The compile time code in Perl_ck_entersub_args_core() that converts a
subroutine call like mypos(1,2) into a direct call to the built-in
function, e.g. pos(1,2), doesn't handle too many args well.
The ops associated with the extra args are excised from the op tree,
but aren't freed, and their op_sigparent pointers aren't updated
correctly.
This is noticeable if op_free() is altered to walk the tree using
op_sigparent to walk back up to the parent.
This commit frees any extra args and emits the 'Too many arguments' error
immediately, rather than tripping over later.
commit 78bb3b143c41ff368fdc4a87f7e9bf36b3023ca2
Author: David Mitchell <da...@iabyn.com>
Date: Fri Apr 12 14:52:27 2019 +0100
fix leak in do { ... } while 0
The op tree for
do X while 0
is simplified to
X
but the const OP for the '0' wasn't being freed and so leaked.
commit a64296af735e8e25c8a1b58cd36a97211c371ac4
Author: David Mitchell <da...@iabyn.com>
Date: Thu Apr 11 17:19:31 2019 +0100
Perl_newLISTOP() allocate OP_PUSHMARK safely
This commit is a prelude to allowing op_free() to make use the parent
pointer at the end of an op_sibling chain to walk a sub-tree to be freed.
newLISTOP() converts 0..2 ops into a list, adding a new parent list op
and possibly a pushmark op. However, under Safe.pm, and specifically in
dist/Safe/t/safeops.t, allocating a pushmark can croak. If the optree
under construct at this point isn't consistent (specifically the parent
pointer not yet set), then this can crash op_free() while trying to walk
the new list to free it.
The fix is to allocate the OP_PUSHMARK if needed *before* messing with
the structure of the list sub-tree.
-----------------------------------------------------------------------
Summary of changes:
op.c | 37 +++++++++++++++++++++++++++++--------
t/lib/warnings/7fatal | 2 ++
t/op/coresubs.t | 2 +-
3 files changed, 32 insertions(+), 9 deletions(-)
diff --git a/op.c b/op.c
index 350032a106..63fe245f06 100644
--- a/op.c
+++ b/op.c
@@ -6101,12 +6101,15 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP
*last)
{
dVAR;
LISTOP *listop;
+ /* Note that allocating an OP_PUSHMARK can die under Safe.pm if
+ * pushmark is banned. So do it now while existing ops are in a
+ * consistent state, in case they suddenly get freed */
+ OP* const pushop = type == OP_LIST ? newOP(OP_PUSHMARK, 0) : NULL;
assert((PL_opargs[type] & OA_CLASS_MASK) == OA_LISTOP
|| type == OP_CUSTOM);
NewOp(1101, listop, 1, LISTOP);
-
OpTYPE_set(listop, type);
if (first || last)
flags |= OPf_KIDS;
@@ -6120,8 +6123,8 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP
*last)
OpMORESIB_set(first, last);
listop->op_first = first;
listop->op_last = last;
- if (type == OP_LIST) {
- OP* const pushop = newOP(OP_PUSHMARK, 0);
+
+ if (pushop) {
OpMORESIB_set(pushop, first);
listop->op_first = pushop;
listop->op_flags |= OPf_KIDS;
@@ -8646,7 +8649,11 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP
*expr, OP *block)
))
/* Return the block now, so that S_new_logop does not try to
fold it away. */
- return block; /* do {} while 0 does once */
+ {
+ op_free(expr);
+ return block; /* do {} while 0 does once */
+ }
+
if (expr->op_type == OP_READLINE
|| expr->op_type == OP_READDIR
|| expr->op_type == OP_GLOB
@@ -13541,13 +13548,26 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV
*namegv, SV *protosv)
case OA_UNOP:
case OA_BASEOP_OR_UNOP:
case OA_FILESTATOP:
- return aop ? newUNOP(opnum,flags,aop) : newOP(opnum,flags);
+ if (!aop)
+ return newOP(opnum,flags); /* zero args */
+ if (aop == prev)
+ return newUNOP(opnum,flags,aop); /* one arg */
+ /* too many args */
+ /* FALLTHROUGH */
case OA_BASEOP:
if (aop) {
- SV *namesv = cv_name((CV *)namegv, NULL, CV_NAME_NOTQUAL);
+ SV *namesv;
+ OP *nextop;
+
+ namesv = cv_name((CV *)namegv, NULL, CV_NAME_NOTQUAL);
yyerror_pv(Perl_form(aTHX_ "Too many arguments for %" SVf,
SVfARG(namesv)), SvUTF8(namesv));
- op_free(aop);
+ while (aop) {
+ nextop = OpSIBLING(aop);
+ op_free(aop);
+ aop = nextop;
+ }
+
}
return opnum == OP_RUNCV
? newPVOP(OP_RUNCV,0,NULL)
@@ -16921,7 +16941,8 @@ OP *
Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
const int opnum)
{
- OP * const argop = newSVOP(OP_COREARGS,0,coreargssv);
+ OP * const argop = (opnum == OP_SELECT && code) ? NULL :
+ newSVOP(OP_COREARGS,0,coreargssv);
OP *o;
PERL_ARGS_ASSERT_CORESUB_OP;
diff --git a/t/lib/warnings/7fatal b/t/lib/warnings/7fatal
index 40c649f249..2056d01e51 100644
--- a/t/lib/warnings/7fatal
+++ b/t/lib/warnings/7fatal
@@ -278,6 +278,7 @@ EXPECT
Reversed += operator at - line 8.
########
# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) >
1 ? "Parser leaks OPs, which leak shared hash keys" : ''
+# SKIP ? $Config{ccflags} =~ /sanitize/
use warnings 'void' ;
@@ -297,6 +298,7 @@ Useless use of time in void context at - line 4.
Useless use of length in void context at - line 9.
########
# TODO ? !$Config{usethreads} && $::UTF8 && ($ENV{PERL_DESTRUCT_LEVEL} || 0) >
1 ? "Parser leaks OPs, which leak shared hash keys" : ''
+# SKIP ? $Config{ccflags} =~ /sanitize/
use warnings ;
diff --git a/t/op/coresubs.t b/t/op/coresubs.t
index 62210b576d..2ee63ef5fc 100644
--- a/t/op/coresubs.t
+++ b/t/op/coresubs.t
@@ -37,7 +37,7 @@ my %args_for = (
splice =>)[0,1,2,1,3,1,4,1,5,1],
);
my %desc = (
- pos => 'match position',
+ #pos => 'match position',
);
use File::Spec::Functions;
--
Perl5 Master Repository
