$foo .= $bar doesn't warn if $foo is undefined, so simplify code.
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index 130daf9..593485d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -506,7 +506,7 @@ S_cop_free(pTHX_ COP* cop)
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
-       SvREFCNT_dec(cop->cop_warnings);
+       PerlMemShared_free(cop->cop_warnings);
     if (! specialCopIO(cop->cop_io)) {
 #ifdef USE_ITHREADS
        /*EMPTY*/
@@ -1974,7 +1974,7 @@ Perl_scope(pTHX_ OP *o)
     }
     return o;
 }
-
+       
 int
 Perl_block_start(pTHX_ int full)
 {
@@ -1983,11 +1983,8 @@ Perl_block_start(pTHX_ int full)
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVESPTR(PL_compiling.cop_warnings);
-    if (! specialWARN(PL_compiling.cop_warnings)) {
-        PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
-        SAVEFREESV(PL_compiling.cop_warnings) ;
-    }
+    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) ;
@@ -2003,7 +2000,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
     OP* const retval = scalarseq(seq);
     LEAVE_SCOPE(floor);
-    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    CopHINTS_set(&PL_compiling, PL_hints);
     if (needblockscope)
        PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy();
@@ -2142,7 +2139,7 @@ Perl_fold_constants(pTHX_ register OP *o)
     register OP *curop;
     OP *newop;
     I32 type = o->op_type;
-    SV *sv;
+    SV *sv = NULL;
     int ret = 0;
     I32 oldscope;
     OP *old_next;
@@ -2243,6 +2240,7 @@ Perl_fold_constants(pTHX_ register OP *o)
 #ifndef PERL_MAD
     op_free(o);
 #endif
+    assert(sv);
     if (type == OP_RV2GV)
        newop = newGVOP(OP_GV, 0, (GV*)sv);
     else
@@ -2842,6 +2840,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        const I32 to_utf    = o->op_private & OPpTRANS_TO_UTF;
        U8* tsave = NULL;
        U8* rsave = NULL;
+       const U32 flags = UTF8_ALLOW_DEFAULT;
 
        if (!from_utf) {
            STRLEN len = tlen;
@@ -2868,11 +2867,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            i = 0;
            transv = newSVpvs("");
            while (t < tend) {
-               cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+               cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
                t += ulen;
                if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {
                    t++;
-                   cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+                   cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
                    t += ulen;
                }
                else {
@@ -2926,11 +2925,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
        while (t < tend || tfirst <= tlast) {
            /* see if we need more "t" chars */
            if (tfirst > tlast) {
-               tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+               tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
                t += ulen;
                if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {    /* illegal utf8 val indicates range */
                    t++;
-                   tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+                   tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
                    t += ulen;
                }
                else
@@ -2940,11 +2939,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            /* now see if we need more "r" chars */
            if (rfirst > rlast) {
                if (r < rend) {
-                   rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+                   rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
                    r += ulen;
                    if (r < rend && NATIVE_TO_UTF(*r) == 0xff) {        /* illegal utf8 val indicates range */
                        r++;
-                       rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+                       rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
                        r += ulen;
                    }
                    else
@@ -3931,11 +3930,11 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
        cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = (U8)flags;
-    cop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    CopHINTS_set(cop, PL_hints);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
-    PL_compiling.op_private = cop->op_private;
+    CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
     cop->op_next = (OP*)cop;
 
     if (label) {
@@ -3944,17 +3943,16 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     }
     cop->cop_seq = seq;
     CopARYBASE_set(cop, CopARYBASE_get(PL_curcop));
-    if (specialWARN(PL_curcop->cop_warnings))
-        cop->cop_warnings = PL_curcop->cop_warnings ;
-    else
-        cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
+    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 = PL_curcop->cop_hints;
     if (cop->cop_hints) {
+       HINTS_REFCNT_LOCK;
        cop->cop_hints->refcounted_he_refcnt++;
+       HINTS_REFCNT_UNLOCK;
     }
 
     if (PL_copline == NOLINE)
@@ -4535,7 +4533,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
        loop = tmp;
     }
 #else
-    Renew(loop, 1, LOOP);
+    loop = PerlMemShared_realloc(loop, sizeof(LOOP));
 #endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
@@ -5120,7 +5118,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        }
     }
     if (const_sv) {
-       SvREFCNT_inc_void_NN(const_sv);
+       SvREFCNT_inc_simple_void_NN(const_sv);
        if (cv) {
            assert(!CvROOT(cv) && !CvCONST(cv));
            sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
@@ -5333,7 +5331,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
            call_list(oldscope, PL_beginav);
 
            PL_curcop = &PL_compiling;
-           PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+           CopHINTS_set(&PL_compiling, PL_hints);
            LEAVE;
        }
        else if (strEQ(s, "END") && !PL_error_count) {