From ad9115fb3ef3c0d588afd07c1b794e99cef3e1ed Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 9 Apr 2019 10:33:34 +0100 Subject: [PATCH] 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. --- op.c | 19 ++++++++++++++++--- t/op/coresubs.t | 2 +- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/op.c b/op.c index d896300..e630ee5 100644 --- a/op.c +++ b/op.c @@ -13548,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) diff --git a/t/op/coresubs.t b/t/op/coresubs.t index 62210b5..2ee63ef 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; -- 1.8.3.1