Error in the formulation of the new warning, spotted by Dominic Dunlop

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

diff --git a/op.c b/op.c
index 5afda98..4716788 100644 (file)
--- a/op.c
+++ b/op.c
@@ -495,13 +495,6 @@ S_cop_free(pTHX_ COP* cop)
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
        PerlMemShared_free(cop->cop_warnings);
-    if (! specialCopIO(cop->cop_io)) {
-#ifdef USE_ITHREADS
-       NOOP;
-#else
-       SvREFCNT_dec(cop->cop_io);
-#endif
-    }
     Perl_refcounted_he_free(aTHX_ cop->cop_hints_hash);
 }
 
@@ -647,7 +640,7 @@ Perl_scalar(pTHX_ OP *o)
            else
                scalar(kid);
        }
-       WITH_THR(PL_curcop = &PL_compiling);
+       PL_curcop = &PL_compiling;
        break;
     case OP_SCOPE:
     case OP_LINESEQ:
@@ -658,7 +651,7 @@ Perl_scalar(pTHX_ OP *o)
            else
                scalar(kid);
        }
-       WITH_THR(PL_curcop = &PL_compiling);
+       PL_curcop = &PL_compiling;
        break;
     case OP_SORT:
        if (ckWARN(WARN_VOID))
@@ -995,7 +988,7 @@ Perl_list(pTHX_ OP *o)
            else
                list(kid);
        }
-       WITH_THR(PL_curcop = &PL_compiling);
+       PL_curcop = &PL_compiling;
        break;
     case OP_SCOPE:
     case OP_LINESEQ:
@@ -1005,7 +998,7 @@ Perl_list(pTHX_ OP *o)
            else
                list(kid);
        }
-       WITH_THR(PL_curcop = &PL_compiling);
+       PL_curcop = &PL_compiling;
        break;
     case OP_REQUIRE:
        /* all requires must return a boolean value */
@@ -1977,11 +1970,6 @@ Perl_block_start(pTHX_ int full)
     PL_hints &= ~HINT_BLOCK_SCOPE;
     SAVECOMPILEWARNINGS();
     PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
-    SAVESPTR(PL_compiling.cop_io);
-    if (! specialCopIO(PL_compiling.cop_io)) {
-        PL_compiling.cop_io = newSVsv(PL_compiling.cop_io) ;
-        SAVEFREESV(PL_compiling.cop_io) ;
-    }
     return retval;
 }
 
@@ -3795,7 +3783,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
         * to store these values, evil chicanery is done with SvCUR().
         */
 
-       if (!(left->op_private & OPpLVAL_INTRO)) {
+       {
            OP *lastop = o;
            PL_generation++;
            for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -3812,6 +3800,17 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                             curop->op_type == OP_PADHV ||
                             curop->op_type == OP_PADANY)
                    {
+                       if (curop->op_private & OPpPAD_STATE) {
+                           if (left->op_private & OPpLVAL_INTRO) {
+                               o->op_private |= OPpASSIGN_STATE;
+                               /* hijacking PADSTALE for uninitialized state variables */
+                               SvPADSTALE_on(PAD_SVl(curop->op_targ));
+                           }
+                           else if (ckWARN(WARN_MISC)) {
+                               Perl_warner(aTHX_ packWARN(WARN_MISC), "State variable %s will be reinitialized",
+                                       PAD_COMPNAME_PV(curop->op_targ));
+                           }
+                       }
                        if (PAD_COMPNAME_GEN(curop->op_targ)
                                                    == (STRLEN)PL_generation)
                            break;
@@ -3950,10 +3949,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        CopHINTS and a possible value in cop_hints_hash, so no need to copy it.
     */
     cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
-    if (specialCopIO(PL_curcop->cop_io))
-        cop->cop_io = PL_curcop->cop_io;
-    else
-        cop->cop_io = newSVsv(PL_curcop->cop_io) ;
     cop->cop_hints_hash = PL_curcop->cop_hints_hash;
     if (cop->cop_hints_hash) {
        HINTS_REFCNT_LOCK;
@@ -5832,7 +5827,7 @@ Perl_ck_bitop(pTHX_ OP *o)
         (op) == OP_EQ   || (op) == OP_I_EQ || \
         (op) == OP_NE   || (op) == OP_I_NE || \
         (op) == OP_NCMP || (op) == OP_I_NCMP)
-    o->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    o->op_private = (U8)(PL_hints & HINT_INTEGER);
     if (!(o->op_flags & OPf_STACKED) /* Not an assignment */
            && (o->op_type == OP_BIT_OR
             || o->op_type == OP_BIT_AND
@@ -6087,24 +6082,24 @@ Perl_ck_rvconst(pTHX_ register OP *o)
        /* Is it a constant from cv_const_sv()? */
        if (SvROK(kidsv) && SvREADONLY(kidsv)) {
            SV * const rsv = SvRV(kidsv);
-           const int svtype = SvTYPE(rsv);
+           const svtype type = SvTYPE(rsv);
             const char *badtype = NULL;
 
            switch (o->op_type) {
            case OP_RV2SV:
-               if (svtype > SVt_PVMG)
+               if (type > SVt_PVMG)
                    badtype = "a SCALAR";
                break;
            case OP_RV2AV:
-               if (svtype != SVt_PVAV)
+               if (type != SVt_PVAV)
                    badtype = "an ARRAY";
                break;
            case OP_RV2HV:
-               if (svtype != SVt_PVHV)
+               if (type != SVt_PVHV)
                    badtype = "a HASH";
                break;
            case OP_RV2CV:
-               if (svtype != SVt_PVCV)
+               if (type != SVt_PVCV)
                    badtype = "a CODE";
                break;
            }