perldelta for cfc7ef1

[perl5.git] / op.c

diff --git a/op.c b/op.c
index 15c3c04..aba7a9b 100644 (file)
--- a/op.c
+++ b/op.c
@@ -725,6 +725,11 @@ Perl_op_free(pTHX_ OP *o)
        return;
 
     type = o->op_type;
+
+    /* an op should only ever acquire op_private flags that we know about.
+     * If this fails, you may need to fix something in regen/op_private */
+    assert(!(o->op_private & ~PL_op_private_valid[type]));
+
     if (o->op_private & OPpREFCOUNTED) {
        switch (type) {
        case OP_LEAVESUB:
@@ -3726,6 +3731,7 @@ S_fold_constants(pTHX_ OP *o)
     SV * const oldwarnhook = PL_warnhook;
     SV * const olddiehook  = PL_diehook;
     COP not_compiling;
+    U8 oldwarn = PL_dowarn;
     dJMPENV;
 
     PERL_ARGS_ASSERT_FOLD_CONSTANTS;
@@ -3820,6 +3826,10 @@ S_fold_constants(pTHX_ OP *o)
     PL_diehook  = NULL;
     JMPENV_PUSH(ret);
 
+    /* Effective $^W=1.  */
+    if ( ! (PL_dowarn & G_WARN_ALL_MASK))
+       PL_dowarn |= G_WARN_ON;
+
     switch (ret) {
     case 0:
        CALLRUNOPS(aTHX);
@@ -3849,6 +3859,7 @@ S_fold_constants(pTHX_ OP *o)
        Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
     }
     JMPENV_POP;
+    PL_dowarn   = oldwarn;
     PL_warnhook = oldwarnhook;
     PL_diehook  = olddiehook;
     PL_curcop = &PL_compiling;
@@ -7199,6 +7210,10 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
            return NULL;
        if (type == OP_CONST && cSVOPo->op_sv)
            sv = cSVOPo->op_sv;
+       else if (type == OP_UNDEF && !o->op_private) {
+           sv = newSV(0);
+           SAVEFREESV(sv);
+       }
        else if (cv && type == OP_CONST) {
            sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ);
            if (!sv)
@@ -7353,10 +7368,13 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        if (CvNAMED(*spot))
            hek = CvNAME_HEK(*spot);
        else {
+            dVAR;
+           U32 hash;
+           PERL_HASH(hash, PadnamePV(name)+1, PadnameLEN(name)-1);
            CvNAME_HEK_set(*spot, hek =
                share_hek(
                    PadnamePV(name)+1,
-                   PadnameLEN(name)-1 * (PadnameUTF8(name) ? -1 : 1), 0
+                   PadnameLEN(name)-1 * (PadnameUTF8(name) ? -1 : 1), hash
                )
            );
        }
@@ -7486,13 +7504,16 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
    setname:
     if (!CvNAME_HEK(cv)) {
-       CvNAME_HEK_set(cv,
-        hek
-         ? share_hek_hek(hek)
-         : share_hek(PadnamePV(name)+1,
+       if (hek) (void)share_hek_hek(hek);
+       else {
+            dVAR;
+           U32 hash;
+           PERL_HASH(hash, PadnamePV(name)+1, PadnameLEN(name)-1);
+           hek = share_hek(PadnamePV(name)+1,
                      PadnameLEN(name)-1 * (PadnameUTF8(name) ? -1 : 1),
-                     0)
-       );
+                     hash);
+       }
+       CvNAME_HEK_set(cv, hek);
     }
     if (const_sv) goto clone;
 
@@ -7712,12 +7733,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                                 o ? (const GV *)cSVOPo->op_sv : NULL, ps,
                                 ps_len, ps_utf8);
        }
-       if (ps) {
+       if (!SvROK(gv)) {
+         if (ps) {
            sv_setpvn(MUTABLE_SV(gv), ps, ps_len);
             if ( ps_utf8 ) SvUTF8_on(MUTABLE_SV(gv));
-        }
-       else
+          }
+         else
            sv_setiv(MUTABLE_SV(gv), -1);
+       }
 
        SvREFCNT_dec(PL_compcv);
        cv = PL_compcv = NULL;
@@ -8867,8 +8890,7 @@ Perl_ck_rvconst(pTHX_ OP *o)
         * whether the lexer already added THIS instance of this symbol.
         */
        iscv = (o->op_type == OP_RV2CV) * 2;
-       do {
-           gv = gv_fetchsv(kidsv,
+       gv = gv_fetchsv(kidsv,
                noexpand
                    ? noexpand
                    : iscv | !(kid->op_private & OPpCONST_ENTERED),
@@ -8881,8 +8903,6 @@ Perl_ck_rvconst(pTHX_ OP *o)
                            : o->op_type == OP_RV2HV
                                ? SVt_PVHV
                                : SVt_PVGV);
-       } while (!noexpand && !gv && !(kid->op_private & OPpCONST_ENTERED)
-             && !iscv++);
        if (gv) {
            kid->op_type = OP_GV;
            SvREFCNT_dec(kid->op_sv);
@@ -9654,12 +9674,15 @@ Perl_ck_require(pTHX_ OP *o)
 
     if (o->op_flags & OPf_KIDS) {      /* Shall we supply missing .pm? */
        SVOP * const kid = (SVOP*)cUNOPo->op_first;
-
-       if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
-           SV * const sv = kid->op_sv;
-           U32 was_readonly = SvREADONLY(sv);
-           char *s;
-           STRLEN len;
+       HEK *hek;
+       U32 hash;
+       char *s;
+       STRLEN len;
+       if (kid->op_type == OP_CONST) {
+         SV * const sv = kid->op_sv;
+         U32 const was_readonly = SvREADONLY(sv);
+         if (kid->op_private & OPpCONST_BARE) {
+            dVAR;
            const char *end;
 
            if (was_readonly) {
@@ -9679,7 +9702,33 @@ Perl_ck_require(pTHX_ OP *o)
            }
            SvEND_set(sv, end);
            sv_catpvs(sv, ".pm");
+           PERL_HASH(hash, SvPVX(sv), SvCUR(sv));
+           hek = share_hek(SvPVX(sv),
+                           (SSize_t)SvCUR(sv) * (SvUTF8(sv) ? -1 : 1),
+                           hash);
+           sv_sethek(sv, hek);
+           unshare_hek(hek);
            SvFLAGS(sv) |= was_readonly;
+         }
+         else if (SvPOK(sv) && !SvNIOK(sv) && !SvGMAGICAL(sv)) {
+           s = SvPV(sv, len);
+           if (SvREFCNT(sv) > 1) {
+               kid->op_sv = newSVpvn_share(
+                   s, SvUTF8(sv) ? -(SSize_t)len : (SSize_t)len, 0);
+               SvREFCNT_dec_NN(sv);
+           }
+           else {
+                dVAR;
+               if (was_readonly) SvREADONLY_off(sv);
+               PERL_HASH(hash, s, len);
+               hek = share_hek(s,
+                               SvUTF8(sv) ? -(SSize_t)len : (SSize_t)len,
+                               hash);
+               sv_sethek(sv, hek);
+               unshare_hek(hek);
+               SvFLAGS(sv) |= was_readonly;
+           }
+         }
        }
     }
 
@@ -10255,32 +10304,6 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
                    goto wrapref;       /* autoconvert GLOB -> GLOBref */
                else if (o3->op_type == OP_CONST)
                    o3->op_private &= ~OPpCONST_STRICT;
-               else if (o3->op_type == OP_ENTERSUB) {
-                   /* accidental subroutine, revert to bareword */
-                   OP *gvop = ((UNOP*)o3)->op_first;
-                   if (gvop && gvop->op_type == OP_NULL) {
-                       gvop = ((UNOP*)gvop)->op_first;
-                       if (gvop) {
-                           for (; OP_HAS_SIBLING(gvop); gvop = OP_SIBLING(gvop))
-                               ;
-                           if (gvop &&
-                                   (gvop->op_private & OPpENTERSUB_NOPAREN) &&
-                                   (gvop = ((UNOP*)gvop)->op_first) &&
-                                   gvop->op_type == OP_GV)
-                           {
-                                OP * newop;
-                               GV * const gv = cGVOPx_gv(gvop);
-                               SV * const n = newSVpvs("");
-                               gv_fullname4(n, gv, "", FALSE);
-                                /* replace the aop subtree with a const op */
-                               newop = newSVOP(OP_CONST, 0, n);
-                                op_sibling_splice(parent, prev, 1, newop);
-                               op_free(aop);
-                                aop = newop;
-                           }
-                       }
-                   }
-               }
                scalar(aop);
                break;
            case '+':