Add Stephen Bennett to AUTHORS

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 1ca495c..50a6179 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3091,6 +3091,13 @@ Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
 
     if (!(PL_opargs[type] & OA_MARK))
        op_null(cLISTOPo->op_first);
+    else {
+       OP * const kid2 = cLISTOPo->op_first->op_sibling;
+       if (kid2 && kid2->op_type == OP_COREARGS) {
+           op_null(cLISTOPo->op_first);
+           kid2->op_private |= OPpCOREARGS_PUSHMARK;
+       }
+    }  
 
     o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
@@ -7685,6 +7692,16 @@ Perl_ck_fun(pTHX_ OP *o)
            tokid = &kid->op_sibling;
            kid = kid->op_sibling;
        }
+       if (kid && kid->op_type == OP_COREARGS) {
+           bool optional = FALSE;
+           while (oa) {
+               numargs++;
+               if (oa & OA_OPTIONAL) optional = TRUE;
+               oa = oa >> 4;
+           }
+           if (optional) o->op_private |= numargs;
+           return o;
+       }
 
        while (oa) {
            if (oa & OA_OPTIONAL || (oa & 7) == OA_LIST) {
@@ -10331,6 +10348,7 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
                       const int opnum)
 {
     OP * const argop = newSVOP(OP_COREARGS,0,coreargssv);
+    OP *o;
 
     PERL_ARGS_ASSERT_CORESUB_OP;
 
@@ -10343,6 +10361,19 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
                                  newOP(OP_CALLER,0)
                       )
               );
+    case OP_SELECT: /* which represents OP_SSELECT as well */
+       if (code)
+           return newCONDOP(
+                        0,
+                        newBINOP(OP_GT, 0,
+                                 newAVREF(newGVOP(OP_GV, 0, PL_defgv)),
+                                 newSVOP(OP_CONST, 0, newSVuv(1))
+                                ),
+                        coresub_op(newSVuv((UV)OP_SSELECT), 0,
+                                   OP_SSELECT),
+                        coresub_op(coreargssv, 0, OP_SELECT)
+                  );
+       /* FALL THROUGH */
     default:
        switch (PL_opargs[opnum] & OA_CLASS_MASK) {
        case OA_BASEOP:
@@ -10351,8 +10382,26 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code,
                        newOP(opnum,
                              opnum == OP_WANTARRAY ? OPpOFFBYONE << 8 : 0)
                   );
+       case OA_BASEOP_OR_UNOP:
+           o = newUNOP(opnum,0,argop);
+           if (opnum == OP_CALLER) o->op_private |= OPpOFFBYONE;
+           else {
+         onearg:
+             if (is_handle_constructor(o, 1))
+               argop->op_private |= OPpCOREARGS_DEREF1;
+           }
+           return o;
        default:
-           return newUNOP(opnum,0,argop);
+           o = convert(opnum,0,argop);
+           if (is_handle_constructor(o, 2))
+               argop->op_private |= OPpCOREARGS_DEREF2;
+           if (scalar_mod_type(NULL, opnum))
+               argop->op_private |= OPpCOREARGS_SCALARMOD;
+           if (opnum == OP_SUBSTR) {
+               o->op_private |= OPpMAYBE_LVSUB;
+               return o;
+           }
+           else goto onearg;
        }
     }
 }