Integrate with Sarathy.

[p5sagit/p5-mst-13.2.git] / op.c

diff --git a/op.c b/op.c
index ece04f7..313cce7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2762,7 +2762,6 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
        }
        else {
            OP *pack;
-           OP *meth;
 
            if (version->op_type != OP_CONST || !SvNIOK(vesv))
                Perl_croak(aTHX_ "Version number must be constant number");
@@ -2771,11 +2770,11 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
            pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
            /* Fake up a method call to VERSION */
-           meth = newSVOP(OP_CONST, 0, newSVpvn("VERSION", 7));
            veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                            append_elem(OP_LIST,
                            prepend_elem(OP_LIST, pack, list(version)),
-                           newUNOP(OP_METHOD, 0, meth)));
+                           newSVOP(OP_METHOD_NAMED, 0,
+                                   newSVpvn("VERSION", 7))));
        }
     }
 
@@ -2788,15 +2787,12 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
     else {
        /* Make copy of id so we don't free it twice */
        pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
-       meth = newSVOP(OP_CONST, 0,
-           aver
-               ? newSVpvn("import", 6)
-               : newSVpvn("unimport", 8)
-           );
        imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
                    append_elem(OP_LIST,
                        prepend_elem(OP_LIST, pack, list(arg)),
-                       newUNOP(OP_METHOD, 0, meth)));
+                       newSVOP(OP_METHOD_NAMED, 0,
+                               aver ? newSVpvn("import", 6)
+                                    : newSVpvn("unimport", 8))));
     }
 
     /* Fake up a require, handle override, if any */
@@ -4802,10 +4798,17 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
+#ifdef IV_IS_QUAD
+                   if (ckWARN(WARN_SYNTAX))
+                       Perl_warner(aTHX_ WARN_SYNTAX,
+                           "Array @%s missing the @ in argument %" PERL_PRId64 " of %s()",
+                           name, (IV)numargs, PL_op_desc[type]);
+#else
                    if (ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ WARN_SYNTAX,
                            "Array @%s missing the @ in argument %ld of %s()",
                            name, (long)numargs, PL_op_desc[type]);
+#endif
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -4822,10 +4825,17 @@ Perl_ck_fun(pTHX_ OP *o)
                    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
+#ifdef IV_IS_QUAD
+                   if (ckWARN(WARN_SYNTAX))
+                       Perl_warner(aTHX_ WARN_SYNTAX,
+                           "Hash %%%s missing the %% in argument %" PERL_PRId64 " of %s()",
+                           name, (IV)numargs, PL_op_desc[type]);
+#else
                    if (ckWARN(WARN_SYNTAX))
                        Perl_warner(aTHX_ WARN_SYNTAX,
                            "Hash %%%s missing the %% in argument %ld of %s()",
                            name, (long)numargs, PL_op_desc[type]);
+#endif
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -5127,7 +5137,9 @@ Perl_ck_sassign(pTHX_ OP *o)
        OP *kkid = kid->op_sibling;
 
        /* Can just relocate the target. */
-       if (kkid && kkid->op_type == OP_PADSV) {
+       if (kkid && kkid->op_type == OP_PADSV
+           && !(kkid->op_private & OPpLVAL_INTRO))
+       {
            /* Concat has problems if target is equal to right arg. */
            if (kid->op_type == OP_CONCAT
                && kLISTOP->op_first->op_sibling->op_type == OP_PADSV
@@ -5168,6 +5180,26 @@ Perl_ck_match(pTHX_ OP *o)
 }
 
 OP *
+Perl_ck_method(pTHX_ OP *o)
+{
+    OP *kid = cUNOPo->op_first;
+    if (kid->op_type == OP_CONST) {
+       SV* sv = kSVOP->op_sv;
+       if (!(strchr(SvPVX(sv), ':') || strchr(SvPVX(sv), '\''))) {
+           OP *cmop;
+           sv_upgrade(sv, SVt_PVIV);
+           SvIOK_on(sv);
+           PERL_HASH(SvUVX(sv), SvPVX(sv), SvCUR(sv));
+           cmop = newSVOP(OP_METHOD_NAMED, 0, sv);
+           kSVOP->op_sv = Nullsv;
+           op_free(o);
+           return cmop;
+       }
+    }
+    return o;
+}
+
+OP *
 Perl_ck_null(pTHX_ OP *o)
 {
     return o;
@@ -5461,7 +5493,7 @@ Perl_ck_subr(pTHX_ OP *o)
            }
        }
     }
-    else if (cvop->op_type == OP_METHOD) {
+    else if (cvop->op_type == OP_METHOD || cvop->op_type == OP_METHOD_NAMED) {
        if (o2->op_type == OP_CONST)
            o2->op_private &= ~OPpCONST_STRICT;
        else if (o2->op_type == OP_LIST) {
@@ -5679,6 +5711,7 @@ Perl_peep(pTHX_ register OP *o)
                        goto ignore_optimization;
                    } else {
                        o->op_targ = o->op_next->op_targ;
+                       o->op_private |= OPpTARGET_MY;
                    }
                }
                null(o->op_next);
@@ -5763,6 +5796,8 @@ Perl_peep(pTHX_ register OP *o)
        case OP_GREPWHILE:
        case OP_AND:
        case OP_OR:
+       case OP_ANDASSIGN:
+       case OP_ORASSIGN:
        case OP_COND_EXPR:
        case OP_RANGE:
            o->op_seq = PL_op_seqmax++;