An inconvenient hang would happen if the stdio _ptr wasn't

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

diff --git a/op.c b/op.c
index 1aa558e..3b04fc0 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;
 }
 
@@ -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)
@@ -4554,12 +4569,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (const_sv) {
        SvREFCNT_inc(const_sv);
        if (cv) {
-           cv_undef(cv);
+           assert(!CvROOT(cv) && !CvCONST(cv));
            sv_setpv((SV*)cv, "");  /* prototype is "" */
            CvXSUBANY(cv).any_ptr = const_sv;
            CvXSUB(cv) = const_sv_xsub;
            CvCONST_on(cv);
-           /* XXX Does anybody care that CvFILE(cv) is blank? */
        }
        else {
            GvCV(gv) = Nullcv;
@@ -6585,7 +6599,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 +6608,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 +6932,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*)XSANY.any_ptr;
     XSRETURN(1);
 }