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.

diff --git a/op.c b/op.c
index d896300..e630ee5 100644 (file)
--- 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 (file)
--- 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;