Add newSVpvs_flags() as a wrapper to newSVpvn_flags(), and rework

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 05ddc86..42f997d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3532,7 +3532,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 +4937,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:
@@ -5580,7 +5585,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
                           CopFILE(PL_curcop),
                           (long)PL_subline, (long)CopLINE(PL_curcop));
            gv_efullname3(tmpstr, gv, NULL);
-           hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvCUR(tmpstr), sv, 0);
+           (void)hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr),
+                   SvCUR(tmpstr), sv, 0);
            hv = GvHVn(db_postponed);
            if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr))) {
                CV * const pcv = GvCV(db_postponed);
@@ -5695,6 +5701,13 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 
     ENTER;
 
+    if (IN_PERL_RUNTIME) {
+       /* at runtime, it's not safe to manipulate PL_curcop: it may be
+        * an op shared between threads. Use a non-shared COP for our
+        * dirty work */
+        SAVEVPTR(PL_curcop);
+        PL_curcop = &PL_compiling;
+    }
     SAVECOPLINE(PL_curcop);
     CopLINE_set(PL_curcop, PL_parser ? PL_parser->copline : NOLINE);
 
@@ -7018,6 +7031,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)
@@ -7210,6 +7224,8 @@ Perl_ck_require(pTHX_ OP *o)
            SV * const sv = kid->op_sv;
            U32 was_readonly = SvREADONLY(sv);
            char *s;
+           STRLEN len;
+           const char *end;
 
            if (was_readonly) {
                if (SvFAKE(sv)) {
@@ -7221,14 +7237,17 @@ Perl_ck_require(pTHX_ OP *o)
                }
            }   
 
-           for (s = SvPVX(sv); *s; s++) {
+           s = SvPVX(sv);
+           len = SvCUR(sv);
+           end = s + len;
+           for (; s < end; s++) {
                if (*s == ':' && s[1] == ':') {
-                   const STRLEN len = strlen(s+2)+1;
                    *s = '/';
-                   Move(s+2, s+1, len, char);
-                   SvCUR_set(sv, SvCUR(sv) - 1);
+                   Move(s+2, s+1, end - s - 1, char);
+                   --end;
                }
            }
+           SvEND_set(sv, end);
            sv_catpvs(sv, ".pm");
            SvFLAGS(sv) |= was_readonly;
        }
@@ -7539,8 +7558,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);
@@ -7873,6 +7892,27 @@ Perl_ck_substr(pTHX_ OP *o)
     return o;
 }
 
+OP *
+Perl_ck_each(pTHX_ OP *o)
+{
+
+    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 */
@@ -8432,7 +8472,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)