Fix regexec.c so $^N and $+ are correctly updated so that they work properly inside...

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

diff --git a/op.c b/op.c
index 3b40d3e..4f8879e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3432,14 +3432,23 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
     pm = (PMOP*)o;
 
     if (expr->op_type == OP_CONST) {
-       SV * const pat = ((SVOP*)expr)->op_sv;
+       SV *pat = ((SVOP*)expr)->op_sv;
        U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
 
        if (o->op_flags & OPf_SPECIAL)
            pm_flags |= RXf_SPLIT;
 
-       if (DO_UTF8(pat))
-           pm_flags |= RXf_UTF8;
+       if (DO_UTF8(pat)) {
+           assert (SvUTF8(pat));
+       } else if (SvUTF8(pat)) {
+           /* Not doing UTF-8, despite what the SV says. Is this only if we're
+              trapped in use 'bytes'?  */
+           /* Make a copy of the octet sequence, but without the flag on, as
+              the compiler now honours the SvUTF8 flag on pat.  */
+           STRLEN len;
+           const char *const p = SvPV(pat, len);
+           pat = newSVpvn_flags(p, len, SVs_TEMP);
+       }
 
        PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
 
@@ -3532,7 +3541,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
        if (curop == repl
            && !(repl_has_vars
                 && (!PM_GETRE(pm)
-                    || PM_GETRE(pm)->extflags & RXf_EVAL_SEEN)))
+                    || RX_EXTFLAGS(PM_GETRE(pm)) & RXf_EVAL_SEEN)))
        {
            pm->op_pmflags |= PMf_CONST;        /* const for long enough */
            prepend_elem(o->op_type, scalar(repl), o);
@@ -4937,6 +4946,11 @@ S_looks_like_bool(pTHX_ const OP *o)
                looks_like_bool(cLOGOPo->op_first)
             && looks_like_bool(cLOGOPo->op_first->op_sibling));
 
+       case OP_NULL:
+           return (
+               o->op_flags & OPf_KIDS
+           && looks_like_bool(cUNOPo->op_first));
+
        case OP_ENTERSUB:
 
        case OP_NOT:    case OP_XOR:
@@ -7026,6 +7040,7 @@ Perl_ck_smartmatch(pTHX_ OP *o)
 OP *
 Perl_ck_sassign(pTHX_ OP *o)
 {
+    dVAR;
     OP * const kid = cLISTOPo->op_first;
     /* has a disposable target? */
     if ((PL_opargs[kid->op_type] & OA_TARGLEX)
@@ -7237,7 +7252,7 @@ Perl_ck_require(pTHX_ OP *o)
            for (; s < end; s++) {
                if (*s == ':' && s[1] == ':') {
                    *s = '/';
-                   Move(s+2, s+1, end - s, char);
+                   Move(s+2, s+1, end - s - 1, char);
                    --end;
                }
            }
@@ -7552,8 +7567,8 @@ Perl_ck_join(pTHX_ OP *o)
     if (kid && kid->op_type == OP_MATCH) {
        if (ckWARN(WARN_SYNTAX)) {
             const REGEXP *re = PM_GETRE(kPMOP);
-           const char *pmstr = re ? re->precomp : "STRING";
-           const STRLEN len = re ? re->prelen : 6;
+           const char *pmstr = re ? RX_PRECOMP(re) : "STRING";
+           const STRLEN len = re ? RX_PRELEN(re) : 6;
            Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                        "/%.*s/ should probably be written as \"%.*s\"",
                        (int)len, pmstr, (int)len, pmstr);
@@ -7886,6 +7901,27 @@ Perl_ck_substr(pTHX_ OP *o)
     return o;
 }
 
+OP *
+Perl_ck_each(pTHX_ OP *o)
+{
+    dVAR;
+    OP *kid = cLISTOPo->op_first;
+
+    if (kid->op_type == OP_PADAV || kid->op_type == OP_RV2AV) {
+       const unsigned new_type = o->op_type == OP_EACH ? OP_AEACH
+           : o->op_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
+       o->op_type = new_type;
+       o->op_ppaddr = PL_ppaddr[new_type];
+    }
+    else if (!(kid->op_type == OP_PADHV || kid->op_type == OP_RV2HV
+              || (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE)
+              )) {
+       bad_type(1, "hash or array", PL_op_desc[o->op_type], kid);
+       return o;
+    }
+    return ck_fun(o);
+}
+
 /* A peephole optimizer.  We visit the ops in the order they're to execute.
  * See the comments at the top of this file for more details about when
  * peep() is called */
@@ -8445,7 +8481,7 @@ Perl_peep(pTHX_ register OP *o)
            UNOP *refgen, *rv2cv;
            LISTOP *exlist;
 
-           if ((o->op_flags && OPf_WANT) != OPf_WANT_VOID)
+           if ((o->op_flags & OPf_WANT) != OPf_WANT_VOID)
                break;
 
            if ((o->op_private & ~OPpASSIGN_BACKWARDS) != 2)