Comment on comment.

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

diff --git a/op.c b/op.c
index 9e256a3..07d147d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -853,6 +853,8 @@ S_cop_free(pTHX_ COP* cop)
 #endif
     if (! specialWARN(cop->cop_warnings))
        SvREFCNT_dec(cop->cop_warnings);
+    if (! specialCopIO(cop->cop_io))
+       SvREFCNT_dec(cop->cop_io);
 }
 
 STATIC void
@@ -2075,6 +2077,11 @@ Perl_block_start(pTHX_ int full)
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
         SAVEFREESV(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;
 }
 
@@ -2658,7 +2665,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
            for (j = 0; j < i; j++) {
                U8 *s = cp[j];
                I32 cur = j < i ? cp[j+1] - s : tend - s;
-               UV  val = utf8_to_uv_chk(s, cur, &ulen, 0);
+               UV  val = utf8_to_uv(s, cur, &ulen, 0);
                s += ulen;
                diff = val - nextmin;
                if (diff > 0) {
@@ -2671,7 +2678,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                    }
                }
                if (*s == 0xff)
-                   val = utf8_to_uv_chk(s+1, cur - 1, &ulen, 0);
+                   val = utf8_to_uv(s+1, cur - 1, &ulen, 0);
                if (val >= nextmin)
                    nextmin = val + 1;
            }
@@ -2698,11 +2705,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)utf8_to_uv_chk(t, tend - t, &ulen, 0);
+               tfirst = (I32)utf8_to_uv(t, tend - t, &ulen, 0);
                t += ulen;
                if (t < tend && *t == 0xff) {   /* illegal utf8 val indicates range */
                    t++;
-                   tlast = (I32)utf8_to_uv_chk(t, tend - t, &ulen, 0);
+                   tlast = (I32)utf8_to_uv(t, tend - t, &ulen, 0);
                    t += ulen;
                }
                else
@@ -2712,11 +2719,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)utf8_to_uv_chk(r, rend - r, &ulen, 0);
+                   rfirst = (I32)utf8_to_uv(r, rend - r, &ulen, 0);
                    r += ulen;
                    if (r < rend && *r == 0xff) {       /* illegal utf8 val indicates range */
                        r++;
-                       rlast = (I32)utf8_to_uv_chk(r, rend - r, &ulen, 0);
+                       rlast = (I32)utf8_to_uv(r, rend - r, &ulen, 0);
                        r += ulen;
                    }
                    else
@@ -3535,6 +3542,10 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
         cop->cop_warnings = PL_curcop->cop_warnings ;
     else
         cop->cop_warnings = newSVsv(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) ;
 
 
     if (PL_copline == NOLINE)
@@ -4404,8 +4415,12 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 
        if (sv && o->op_next == o)
            return sv;
-       if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
-           continue;
+       if (o->op_next != o) {
+           if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
+               continue;
+           if (type == OP_DBSTATE)
+               continue;
+       }
        if (type == OP_LEAVESUB || type == OP_RETURN)
            break;
        if (sv)
@@ -4555,6 +4570,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        SvREFCNT_inc(const_sv);
        if (cv) {
            cv_undef(cv);
+#ifdef USE_THREADS
+           New(666, CvMUTEXP(cv), 1, perl_mutex);
+           MUTEX_INIT(CvMUTEXP(cv));
+           CvOWNER(cv) = 0;
+#endif /* USE_THREADS */
            sv_setpv((SV*)cv, "");  /* prototype is "" */
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
@@ -6585,7 +6605,7 @@ Perl_peep(pTHX_ register OP *o)
                PADOFFSET ix = pad_alloc(OP_CONST, SVs_PADTMP);
                if (SvPADTMP(cSVOPo->op_sv)) {
                    /* If op_sv is already a PADTMP then it is being used by
-                    * another pad, so make a copy. */
+                    * some pad, so make a copy. */
                    sv_setsv(PL_curpad[ix],cSVOPo->op_sv);
                    SvREADONLY_on(PL_curpad[ix]);
                    SvREFCNT_dec(cSVOPo->op_sv);
@@ -6594,6 +6614,8 @@ Perl_peep(pTHX_ register OP *o)
                    SvREFCNT_dec(PL_curpad[ix]);
                    SvPADTMP_on(cSVOPo->op_sv);
                    PL_curpad[ix] = cSVOPo->op_sv;
+                   /* XXX I don't know how this isn't readonly already. */
+                   SvREADONLY_on(PL_curpad[ix]);
                }
                cSVOPo->op_sv = Nullsv;
                o->op_targ = ix;
@@ -6916,6 +6938,7 @@ static void
 const_sv_xsub(pTHXo_ CV* cv)
 {
     dXSARGS;
-    ST(0) = sv_2mortal(newSVsv((SV*)XSANY.any_ptr));
+    EXTEND(sp, 1);
+    ST(0) = sv_2mortal(SvREFCNT_inc((SV*)XSANY.any_ptr));
     XSRETURN(1);
 }